Rose-DB-Object-0.810/000750 000765 000120 00000000000 12266514755 014214 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/Changes000644 000765 000120 00000201032 12266514421 015500 0ustar00johnadmin000000 000000 0.810 (01.18.2013) - John Siracusa * Improved automated installation detection (RT 92255) 0.809 (12.04.2013) - John Siracusa * Corrected precision and scale for auto-loaded numeric column metadata. (Reported by Justin Hawkins) 0.808 (11.03.2013) - John Siracusa * Fixed typos. 0.807 (08.28.2013) - John Siracusa * Fixed inheritance of Rose::DB::Object::Cached's cached_objects_expire_in attribute. (Patch by Frank Wesemann) 0.806 (06.08.2013) - John Siracusa * Updated iterator leak test to work on perl 5.17.* and later (RT 86000) 0.805 (03.10.2013) - John Siracusa * Changed the recommended Oracle trigger PL/SQL to avoid sequence gaps. (Patch by Tom Adamo.) * Updated several Manager calls in bench.pl, adding the inject_results parameter. 0.804 (02.01.2013) - John Siracusa * Fixed some test failures on perl 5.16.2, mysql 5.5.29, and DBD::Pg 2.19.3. 0.803 (01.04.2013) - John Siracusa * Make char column's parse_value() method honor a column's overflow attribute when handling column values that are too long. * Correct length value in column overflow error messages. 0.802 (01.03.2013) - John Siracusa * Make varchar column's parse_value() method honor a column's overflow attribute when handling column values that are too long. 0.801 (11.24.2012) - John Siracusa * Fixed "DBD::Informix::st execute failed: SQL: -255: Not in transaction" errors in the test suite. (Patch by Sergey Leschenko.) 0.800 (09.09.2012) - John Siracusa * Correct tests to account for the Loader's init_db generation fix in 0.799 behavior (RT 79526) 0.799 (08.10.2012) - John Siracusa * Added column type mappings for varchar2, nvarchar, and nvarchar2. (Suggested by Chris Campise) * Fixed some typos in the Loader documentation (RT 78860) * Fixed a Loader bug that caused the base class's init_db method to be ignored (RT 78571) 0.798 (04.04.2012) - John Siracusa * Fixed a typo in the Rose::DB::Object::Manager documentation. * Fixed a bug that caused save() not to throw an exception when a transaction could not be started (Reported by jdv79) * Converted some uses of each() to keys() to avoid iteration state bugs (RT 75773) * Corrected a broken POD link in the one-to-many relationship documentation. (Reported by Nee) 0.797 (11.21.2011) - John Siracusa * Fixed a bug that prevented explicitly disabling/enabling column triggers from working (RT 72592) 0.796 (10.18.2011) - John Siracusa * Use ENGINE=InnoDB instead of TYPE=InnoDB in MySQL table creation statements to avoid an incompatibility with MySQL 5.5 (RT 71757) 0.795 (07.14.2011) - John Siracusa * The Loader now passes the Manager class name as a second argument to module_preamble and module_postamble subroutines to allow Manager classes to be distinguished from object classes. * Corrected a typo in the ConventionManager documentation ("objs_" should be "_objs") * Fixed a bug that caused load-on-demand columns to be loaded by load(with => ...) method calls. (Reported by Marlon Bailey) 0.794 (12.30.2010) - John Siracusa * Handle null default values for foreign key columns in PostgreSQL (RT 64331) 0.793 (12.21.2010) - John Siracusa * Corrected skip count in t/db-object.t 0.792 (12.20.2010) - John Siracusa * Detect attempts to create methods whose names conflict with methods defined in Rose::DB::Object itself. (Reported by Dave Howorth) 0.791 (10.23.2010) - John Siracusa * Fixed a bug that caused on_save column triggers to fire when loading. * More floating point rounding fixes in the test suite. 0.790 (10.17.2010) - John Siracusa * The auto-initialization process no longer sets column default values to undef when there is no default for the column. Doing this was tripping up the default_exists() method. (Reported by Timo Karhu) * Documented the behavior of the manager_args relationship attribute when a relationship is used as a with_objects or require_objects argument. * Fixed a bug that caused SET columns to be erroneously marked as modified when their accessor methods were called. * Fixed a bug in make_manager_methods() that left base_name undefined. (RT 61963, patch by Chris Malarky) * Improved handling of floating point and string/number conversions in the test suite. 0.789 (06.23.2010) - John Siracusa * Added support for SELECT FOR UPDATE and other forms of locking (Initial patch by Kostas Chatzikokolakis) * Fixed some POD typos (RT 58405) 0.788 (05.22.2010) - John Siracusa * Fixed a bug that prevented function calls like now() from being properly inlined, even when allow_inline_column_values was set to a true value. (Reported by David Bourget) * The Loader/auto-init system will now automatically set the allow_inline_column_values attribute to a true value when a column has a default value that looks like a function call. * Fixed a non-numeric warning with development releases of Math::BigInt. * Fixed SQL reserved word quoting bug. (Reported by Taric Mirza) * Avoid stringifying exception objects when setting error(). (Suggested by Kostas Chatzikokolakis) 0.787 (04.27.2010) - John Siracusa * Added remarks column attribute. (Patch by Adam Mackler) * Improved error message generated by get_objects_from_sql() when an unknown column is encountered. * Added support for Rose::DB's keyword_function_calls attribute. * Added dedicated timestamp with time zone column type. * Inflate triggers now work correctly with lazy-loaded columns. (Reported by Alex Karelas) * Failure to have any valid registered data sources no longer causes a fatal error when looking up default column sequence names during class setup. 0.786 (01.23.2010) - John Siracusa * Improved support for serial columns in Oracle. * Renamed CHECK labels to avoid clashes with the reserved block name. * Added force_lowercase attribute to the Loader and Convention Manager as a means of getting "normal" behavior out of Oracle schemas. * Fixed a bug that caused money columns in PostgreSQL to have column lengths that were too short. * Fixed a POD typo (RT 53272) 0.785 (12.31.2009) - John Siracusa * Fixed Rose::DB::Object::Cached to correctly honor alternate column accessor/mutator method names. (Reported by Kevin McGrath) * Stopped the default auto-init handler from asking the convention manager to name foreign keys that have only partially populated column lists, causing it to burn through the "good" foreign key names. (Patch by Douglas Wilson) * Corrected some typos in the ManyToMany documentation and the tutorial. (Thanks to Bart Dopheide) 0.784 (10.16.2009) - John Siracusa * Fixed a bug introduced by the multi-many Manager bug fix in the 0.783 release. (Reported by Mark Frost) * Added missing exception error explanations to relationship methods. * Updated eval blocks to avoid stomping on $@ from an outer scope. 0.783 (09.14.2009) - John Siracusa * Added new range operators: between, gt_lt, gt_le, ge_lt, and ge_le. * The strip() helper method will now throw an exception when there are pending "on-save" actions. (Reported by Kevin McGrath) * Added strip_on_save_ok parameter to strip() to override the default behavior. * Worked around yet another MySQL empty-string-default "feature." (Reported by Terrence Brannon) * Added missing documentation about the required return value of the "object" handler in the traverse_depth_first() helper method. (Reported by David Christensen) * The traverse_depth_first() helper now preserves the existing context object if a "relationship" handler is not defined. (Reported by David Christensen) * Fixed a bug that prevented scalar reference filter arguments from working correctly with date columns in Manager queries. (Reported by Todd Lyons) * Fixed a multi-many Manager bug that caused duplicate sub-objects to be linked to the wrong parent object. (Reported by Anton Shevchenko) 0.782 (07.09.2009) - John Siracusa * Altered tests to confirm the fix for RT 45836. * Detect enum-like columns in PostgreSQL. (RT 46214) * Added optional warning to the Loader for missing primary keys. (Patch by Ed Loehr) * Fixed a memory leak in the Iterator class. (RT 47294) (Patch by Thomas Whaples) * Unique indexes that have predicates are now skipped by the auto- initialization process. Use the include_predicated_unique_indexes Metadata attribute and/or Loader attribute to override the default. This feature is currently only supported in PostgreSQL. (Patch by Ed Loehr) * Improved unknown method error messages. (Suggested by Brian Miller) * Updated some example code in the documentation. 0.781 (04.19.2009) - John Siracusa * Added an explicit SQL_BLOB bind_param() argument for blob columns in SQLite. (Reported by clausi) * Added manager_iterator_method and support for manager_count_method and manager_delete_method to relevant Relationship classes. (Patch by Peter Karman) * Updated test suite to consider DBD::SQLite 1.19+ non-broken. 0.780 (03.04.2009) - John Siracusa * Fixed a bug that caused the delete_relationships() Metadata method to fail in some circumstances. (Reported by vti) * Fixed a few accessor/mutator mismatches in relationship methods. (Reported by Bharanee) 0.779 (02.26.2009) - John Siracusa * Added missing documentation on one-to-many and many-to-many relationship "iterator" and "find" method type names. * Corrected an error message in Rose::DB::Object::MakeMethods::Generic (RT 43667) 0.778 (02.06.2009) - John Siracusa * Added PostgreSQL's "ltree" query extensions to QueryBuilder. (Patch by Rick Apichairuk) * Improved the efficiency of the check-and-merge function used when related objects are added. (Reported by Bryan Opfer) 0.777 (12.12.2008) - John Siracusa * Fixed a bug that caused foreign key proxy relationships to be clobbered if relationships were set after foreign_keys. (Reported by Peter Karman) 0.776 (12.09.2008) - John Siracusa * Fixed a bug that was preventing the use of new comparison operators with QueryBuilder. (Reported by Derek Wueppelmann) * Added a strict_ops parameter and class method to the Manager to allow the policy to b changed per-call or per-class. * Auto-initialization under Oracle should no longer be confused by tables with the same names in different schemas. (Patch by Benjamin Hitz) * Removed the on-again, off-again restriction on aliasing primary key columns. I think it's off for good this time. * Refined column alias policy to keep from appearing to override more granular column method name customization. * Overhauled related object mutator methods to better match the documentation and reduce unnecessary queries. * Fixed a bug that caused the init_with_tree() helper method to overwrite columns involved in relationship mapping in some circumstances. (Reported by Todd Lyons) 0.775 (11.02.2008) - John Siracusa * The insert_or_update(), load_or_insert(), and load_or_save() helper methods no longer throw an exception when called on an object with no uniquely identifying column(s). (Suggested by Richard Jones) * Added detection of minimum JSON version (2.00) to test suite and the Helpers module. 0.774 (10.25.2008) - John Siracusa * Setting objects related through a one-to-many relationship now does more work to ensure success. (Reported by vti and David Bourget) * Fixed an ON DUPLICATE KEY UPDATE test to work around a MySQL "strict mode" quirk (or, IMO, "bug") which causes it to complain about a situation that is only a concern if it decided to do an INSERT rather than an UPDATE. (Reported by Richard Jones) * Fixed a regression in t/spot-check-10.t: adding objects to one-to-many-related lists failed in some circumstances. * Updated auto-initialization examples in the synopsis. 0.773 (10.02.2008) - John Siracusa * Added support for multiple add_on_save calls prior to save(), which is how everyone expected it to behave anyway, and how the documentation always seemed to imply that it did work. Well, now it does. * Pre-saved objects now get their foreign key columns hooked up correctly when passed as arguments to add_on_save methods. (Reported by George Hartzell) * ...-to-many related object lists will now be re-fetched on demand after an add_on_save and a subsequent save(). (Reported by George Hartzell) 0.7722 (09.29.2008) - John Siracusa * Fixed compatibility with older versions of ExtUtils::MakeMaker. 0.7721 (09.29.2008) - John Siracusa * Updated distribution metadata for ExtUtils::MakeMaker 6.44. * Added a column type mapping for MySQL's MEDIUMINT type. (Reported by Andreas Dewes) 0.772 (09.26.2008) - John Siracusa * Altered Rose::DB::Object::Cached to override insert() and update methods. (Suggested by Kevin McGrath) * The update() method now marks updated objects as being in the database (see is_in_db() in Rose::DB::Object::Util) (Suggested by Kevin McGrath) * The insert_or_update() and insert_or_update_on_duplicate_key() helper methods now call save() instead of insert() or update() (passing the appropriate flags to cause an insert or update) in order also save child objects. (Suggested by Kevin McGrath) * The set_column_value_modified() function in Rose::DB::Object::Util now also clears any "db-ready" column value the object may be holding for that column. * Added a dirty_columns() helper method (Suggested by jdv79) 0.7713 (09.16.2008) - John Siracusa * More test skipping fixes. 0.7712 (09.15.2008) - John Siracusa * Improved detection of broken DBD::SQLite versions. 0.7711 (09.15.2008) - John Siracusa * Fixed typos in POD. * Improved test skipping conditions. * Clarified JSON module version requirements. 0.771 (09.12.2008) - John Siracusa * Traversal and recursive serialization helper method added. * Non-persistent columns feature added. * Made "where" an alias for the Manager's "query" parameter. (Requested by Ask Bjørn Hansen) * Documented restrictions on the Manager's "select" parameter. * Fixed bug that prevented CURRENT_TIMESTAMP from being properly inlined in queries sent to SQLite. (RT 37224) * Fixed a memory leak. (Reported by Christopher Laco) * The "cluck" error mode now correctly calls cluck() rather than croak(). (Reported by Kevin McGrath) * Added support for Oracle date/time column keywords. * Cascaded delete now properly cascades to one-to-one related objects. (Reported by kittens) 0.770 (05.28.2008) - John Siracusa * Added "iterator" method type, similar to "find", to OneToMany and ManyToMany. (Patch by Peter Karman - peknet@gmail.com) * Updated the Loader documentation to describe an important consideration when regenerating modules with make_modules(). * Improved error propagation in relationship methods. (Suggested by Wiggins d'Anconia) * Skip the interactive part of the test suite when the AUTOMATED_TESTING environment variable is set. * Test suite now accounts for versions of DBD::mysql that predate the mysql_is_auto_increment column attribute. 0.769 (04.01.2008) - John Siracusa * Improved the default singular/plural conversion rules in the Convention Manager. (Suggested by David Brownlee) * Added new join type override syntax for the Manager's with_objects and require_objects parameters. * Added column method naming conventions to the Convention Manager. * Added Manager naming conventions to the Convention Manager and exposed more Manager-related defaults in the Metadata and Manager class. (Patch by Bradley C Bailey, modified by John Siracusa) * Column method names are now allowed at the end of compound Manager query parameters (e.g., "a.b.method") * Clarified column/method query parameter documentation. * PostgreSQL tests are not skipped when DBD::Pg version 2.1.x or 2.2.0 is installed. (Bus error for me in t/deep-joins.t) 0.768 (02.25.2008) - John Siracusa * Changed mailing list and wiki URLs. * Fixed the "warn" overflow mode for character columns to carp instead of croaking. (Reported by John Ingram) * Refined workaround for http://rt.cpan.org//Ticket/Display.html?id=33193 to apply only to versions that exhibited this bug. * Added the forget_related() helper method to the "all" export tag. 0.767 (02.15.2008) - John Siracusa * Added the forget_related() helper method. * Enhanced and documented the long-dormant "hints" Manager parameter. * Added a work-around for a DBD::Pg 2.0.0 array/bind_col() bug: http://rt.cpan.org//Ticket/Display.html?id=33193 * Improved the column method handling for array-reference values that may be fetched from array columns by DBD::Pg 2.0.0. * Fixed a bug in the test suite that caused some PostgreSQL tests to fail if the "chkpass" column type was not installed. (Reported by Randal Schwartz) 0.7665 (02.08.2008) - John Siracusa * Fixed a bug that prevented the convention manager's auto_table_name() method from honoring the tables_are_singular() attribute value. (Reported by Ben Tilly) * The new, more correct behavior of Rose::DB 0.739's array column value parsing and formatting revealed a bug in QueryBuilder's handling of "(any|all)_in_array" conditions involving empty list arguments. This is now fixed. 0.7664 (02.06.2008) - John Siracusa * Fixed a bug that caused boolean columns to be incorrectly marked as modified. (Reported by Grzegorz Nosek) * Added sql_qualify_column_names_on_load() Metadata method to help support PostgreSQL functions that can masquerade as columns if they're prefixed by the table name. (Suggested by Grzegorz Nosek) 0.7663 (02.04.2008) - John Siracusa * Fixed a bug that caused delete_on_save method creation for foreign keys to fail in some circumstances. (Reported by Justin Ellison) * Fixed a bug that prevented Perl code from being emitted for non-set columns with check_in attributes. (Reported by Sam Tregar) * Pushed cache control methods down into Rose::DB::Object::Cached in preparation for more caching subclasses. * The clear_object_cache() method now correctly clears load timestamps as well. (Patch by Justin Ellison) 0.7662 (01.30.2008) - John Siracusa * Fixed copy-and-paste-o in Rose::DB::Object::Cached code. 0.7661 (01.29.2008) - John Siracusa * Fixed method clash detection in Rose::DB::Object::Manager. * Streamlined caching implementation in Rose::DB::Object::Cached. 0.766 (12.13.2007) - John Siracusa * Added the unique_key_by_name() metadata method. * Added the ability to do unrestricted joins in some circumstances. * Added the remember_all() class method to Rose::DB::Object::Cached. * Added the undef_overrides_default column attribute. * The key_column() method in the ForeignKey class now works correctly. (Patch by Christopher Masto) * Further synced datetime and timestamp method-maker code. * Added a test suite exclusion for DBD::SQLite 1.14, which still suffers from this bug: http://rt.cpan.org/Public/Bug/Display.html?id=21472 * Improved detection of fatal errors during class setup. * Added a "gotchas" section to the Loader documentation. * Fixed propagation of db objects in update and delete Manager methods. * Fixed a bug that caused some cached SQL to persist incorrectly after inheritance. (Patch by Daniel Koch) * Fiddled with not_found() detection. (Changes suggested by Philip Dye) * Made one-to-one relationships (attempt to) work even when uniqueness is not apparent in the metadata. * The Loader no longer chokes on SQLite columns that use the current_timestamp keyword. (Reported by George Hartzell) * Setting undef integer attributes to zero is now correctly detected as a modification. 0.765 (07.21.2007) - John Siracusa * Added a value_type attribute to SET columns. * Added a normalize_get_objects_args() utility method to make custom Manager methods less cumbersome to implement. * Setting a BigInt column to undef no longer sets it to zero. (Reported by Jeffrey Horn) * Corrected error propagation in many-to-many "find" methods when bad arguments are passed. (Reported by Michael Reece) * Added "use strict" the output of perl_manager_class(). * Restored default use of table aliases in Manager queries. The new table_aliases parameter can be used to alter the behavior. * Added support for literal sort_by parameters using scalar references. * Added is/is_not comparison operators to QueryBuilder. (Suggested by Jonathan Vanasco) * Scalar references appearing in the select => ... list in Manager calls are now passed through unmodified. * Existing map records are now correctly checked for when adding items through a many-to-many relationship. (Reported by Drew Taylor) * Using a nonexistent column name in a primary or unique key is now a fatal error. (Reported by Philip Dye) * Multi-columns "select count(distinct ...)" queries now fall back to count(*) on a subselect in databases that do not support calling count on multi-argument distinct clauses. (Reported by Derek Watson) * The auto-init system will now skip PostgreSQL functional indexes when extracting unique keys. (Reported by Jonathan Vanasco) * Fixed a bug that caused inner joins to be used inappropriately in certain cases with many-to-many relationships or when nested joins are disabled. * Fixed a bug that caused the auto-init system to fold multiple foreign keys that reference the same remote key into a single multi-column foreign key. (Reported by Marlon Bailey) * Fixed a Manager bug that caused count queries to use incorrect table aliases when passed empty with_objects or require_objects array reference values. (Reported by Denis Moskowitz) * Fixed a bug that prevented relationship and foreign key names from being resolved when used in nested query parameters. * Relationship count methods no longer die when the count is zero. (Reported by Derek Watson) * Setting enum fields to undef now works correctly. (Reported by Ovid) * Columns with custom DBI bind attributes are now updated correctly. (Reported by Derek Watson) * Epoch columns with zero (0) default values now work correctly. (Reported by Peter Karman) * Setting boolean columns to null (undef) now works correctly. (Reported by Derek Watson) * Fixed a bug that caused literal query parameters with bind arguments to become corrupted after their first use. * Changed the way classes are registered in order to fix a Loader bug that caused cross-database foreign keys to be erroneously created when tables with the same names exists in two different databases. (Reported by Adrian Howard) * Deleting one-to-one related objects on save now works correctly. (Reported by Ovid) * The "find" method for many-to-many relationships now propagates custom Manager arguments correctly. (Patch by Michael Reece) * The use_key parameter to load() now dies if an invalid key is passed. (Reported by Jonathan Vanasco) 0.764 (05.04.2007) - John Siracusa * Added the strip() helper method. * Added a "find" method type to many-to-many relationships. * Added a "count" method type to ...-to-many relationships. * Added support for nested joins. * The setup() method now supports a "helpers" shortcut for importing methods from Rose::DB::Object::Helpers. * Added the dubious require_primary_key parameter and object attribute to the Loader. (Requested by Teodor Zlatanov) * Added two syntaxes for literal SQL to QueryBuilder. * Added the with_column_triggers attribute to foreign keys and singular relationships in order to keep columns and related objects in sync. * Fixed a bug that caused some optional related objects to be improperly transformed into required objects. (Reported by Ethan Rowe) * Improved detection of errors when auto-loading related classes. * Duplicate auto-created map record method names are now detected and reported as a fatal error. * Added and documented a return value for add_columns(). * Added module_preamble and module_postamble features to the Loader's make_modules() method. (Patch by David Christensen) * Made changes_only, cascade, and prepare_cached arguments to save() also apply to *_on_save collections. * Added test and prerequisite version for a Rose::DB bug that prevented certain reserved words from being detected as primary key columns in PostgreSQL. (Reported by Fred Cox) * Baseline Oracle support added to the Loader. (Patch by Teodor Zlatanov) * The clone() and clone_and_reset() methods now handle missing or differently named accessor/mutator methods. * QueryBuilder now supports eq/ne undef for is/is not null comparisons. * Foreign key columns that are also primary key columns are no longer set to undef when a foreign object is set to undef. (Reported by Ovid) * Fixed a bug that caused values not to be checked against the list of valid values in SET columns. (Reported by Adrian Howard) * Fixed a bug that caused column (get/)set methods not to return the correct value when an on_set trigger was applied to the column. (Reported by Cory Bennett) * Fixed a bug that caused enum columns to be incorrectly marked as modified in some circumstances. (Reported by Cory Bennett) * Fixed a bug that caused inflate/deflate triggers to fail under some circumstances. (Patch by Cory Bennett) 0.763 (02.24.2007) - John Siracusa * Re-enabled the DBD::SQLite 1.13 work-around in the test suite, which I temporarily disabled to test a 1.14 candidate and then forgot to re-enable before the 0.762 release. 0.762 (02.24.2007) - John Siracusa * Fixed an unparseable version number in MakeMethods::BigNum that was causing CPAN and associated tools to choke. 0.761 (02.23.2007) - John Siracusa * Added the ability to specify a unique key by name in calls to load(). * Added support for query_args and other Manager parameters to one-to-one and one-to-many relationships. * Added a "find" method type to one-to-many relationships for ad-hoc queries. * Added support for Informix's "datetime year to month" column type. * Updated the dbh() method to be a more conventional proxy for ->db->dbh(). * The get_objects() and delete_objects() Manager methods now accept a lone arrayref or hashref argument as a short way to specify the value of the "query" parameter. * Eliminated warning in the BigNum column type when the GMP math library is not installed. * Added a double precision column type and class for PostgreSQL. * Fixed a bug that caused cascaded save() to fail to cascade beyond a set-on-save related object. * Improved reporting of errors in auto-loaded related modules. * Fixed a bug that caused numeric columns to have invalid length restrictions. (Reported by Fred Cox) * Fixed many incorrect skip counts in the test suite when running against PostgreSQL without CHKPASS support. 0.760 (01.16.2007) - John Siracusa * Fixed a mistake in the test suite that caused spurious failures when testing against Pg without the CHKPASS column type installed. (Reported by Randal Schwartz) 0.759 (01.15.2007) - John Siracusa * Oracle support improved significantly. * Added a "state" export tag to Rose::DB::Object::Util. * Fixed a bug that caused the Manager to unconditionally alias selected columns in some situations. * Added the (dubious) ability to set a list of filtered one-to-many items. * Fixed a database handle leak in the iterator class. (Reported by Peter Karman) 0.758 (11.29.2006) - John Siracusa * Added the get_objects_iterator_from_sql() Manager method and an iterator option for the make_manager_method_from_sql() method. (Suggested by George Hartzell) * Turned off unique column aliases by default and added the unique_aliases Manager parameter to turn them back on. * Fixed some circular references that could have caused database connections to leak. (Reported by Bruno Czekay) 0.757 (11.22.2006) - John Siracusa * Added load_or_save() helper method. * Added support for MySQL's SET data type. * Fixed some SET and ARRAY bugs in QueryBuilder. * Fixed a bug that caused QueryBuilder to choke on inflated BigInt columns. (Reported by Jud) * Modified the rules that govern metadata inheritance in order to allow multiple layers of abstract base classes. * The Loader will now pick up custom convention manager classes from the specified base class. 0.756 (10.29.2006) - John Siracusa * Changed the interaction and behavior of the metadata object's foreign_key_name_generator() method and the convention manager's auto_foreign_key_name() method to avoid some name conflict bugs and create a more sensible flow for foreign key naming. (Suggested by Graham Barr) * Added has_modified_children() has_loaded_related() methods to Rose::DB::Object::Util. * Added an init_with_column_value_pairs() helper method. (Requested by Jonathan Vanasco) * Modified child objects are now correctly detected and handled by cascading save(). (Reported by Lucian Dragus) * Fixed a bug that caused save(changes_only => 1, cascade => 1) to fail in cases where a child object set a key column in the parent object. (Reported by Lucian Dragus) * Fixed a bug in the Manager that caused the with_objects parameter to be ignored when the count_only parameter was set. (Reported by Uwe Voelker) * The column_values_as_*() helper methods no longer require the column_value_pairs() helper to also be imported. (Reported by Jonathan Vanasco) * Fixed a bug caused by blank lines in JSON and YAML output. (Patch by Jonathan Vanasco) * Setting a fixed-length character column to undef now works correctly. * Fixed a bug that caused the benchmark suite to fail under SQLite due to a mishandling of the query_is_sql Manager parameter. * Corrected some typos in the documentation. 0.755 (10.20.2006) - John Siracusa * Fixed a bug that could cause ...-to-many accessors with custom sort orders to fail in some situations. * Removed some imported functions to correctly reflect the documented list of reserved method names. (Reported by Uwe Voelker) * Added the allow_empty_lists parameter to the Manager's get_objects() method. (Suggested by Ask Bjørn Hansen) * Fixed bugs in the query hints implementation. 0.754 (10.06.2006) - John Siracusa * Added an optional db argument to the prime_all_caches() and prime_caches() metadata methods. (Suggested by Jonathan Vanasco) * Improved and documented the way that unique keys are selected by the load() method. (Patch by Graham Barr) * Fixed a bug that caused foreign key column lookups to fail in PostgreSQL when using the unicode database encoding. * Invalid dates are now detected in the query portion of Manager calls. * The test suite now refuses to run SQLite tests if the buggy DBD::SQLite version 1.13 is installed. * Fixed some typos in the documentation. 0.753 (09.17.2006) - John Siracusa * Improved the convention manager's plural_to_singular() method. * Added "match", "imatch", and "similar" operators to QueryBuilder. (Patch by Lucian Dragus) * The Loader will now check if a db_class "isa" Rose::DB already before attempting to load it. (Reported by Randal Schwartz) * The auto-initialization system will now correctly connect one-to-one relationships with foreign keys when appropriate. * Fixed a bug that caused the update_objects() and delete_objects() Manager methods to fail to extract the object_class value from the object_class() method. (Patch by Graham Barr) * Fixed a bug that caused "like" and other match operators to be provided with incorrectly formatted arguments when used with fixed-length CHAR columns. (Reported by Ask Bjørn Hansen) 0.752 (09.06.2006) - John Siracusa * The select parameter to the Manager's get_objects() method now accepts tN.* column specifiers. (Suggested by Jonathan Vanasco) * Added auto_relationship_name_*() methods to the convention manager. * Added rudimentary name conflict resolution abilities to the convention manager's auto_*_name() methods. * Altered the meaning of the time column's precision() attribute and added a scale() attribute to take over the previous meaning. * Renamed the interval column's precision() attribute to scale(). * Aliased columns now work correctly with the select parameter to Manager's get_objects() method. * Fixed a bug that caused the get_objects() Manager method to fail to extract the object_class value from the object_class() method. * Fixed a bug that caused Informix datetime column values to have incorrect "largest qualifier" values for values other than "year." * Eliminated an "uninitialized value" warning when running under mod_perl (Patch by Graham Barr) 0.751 (08.29.2006) - John Siracusa * The Loader is now much, much faster when loading many tables. * Added a tables_are_singular() method to the default ConventionManager. * Improved detection of ambiguous columns in QueryBuilder. * Removed a potentially dubious optimization of the with_objects argument to the get_objects() and get_objects_count() methods. * Added support for auto-initialization in setup() calls. * Added prime_caches(), auto_prime_caches(), and prime_all_caches() Metadata methods to help increase shared memory when running under mod_perl and other similar environments. * The Loader's include_tables and exclude_tables attributes now accept references to arrays of table names as well as regular expressions. * The Loader's include_tables and exclude_tables attributes are now case-insensitive by default. * Fixed a bug that caused save() with sub-objects to fail in some cases. (Reported by Wiggins d'Anconia) * Added examples of the add_on_save relationship methods to the tutorial. 0.75 (08.10.2006) - John Siracusa * Added a cascade option to save(). * Added auto-detection of one-to-one relationships to the Loader. * The object_class parameter to Manager methods now defaults to the return value of the object_class() class method. * The soft() and referential_integrity() methods of the ManyToOne and OneToOne relationship classes have been renamed to optional() and required(), respectively. The old method names still work, but may be removed at some later date. Also, the default values are now determined by a new set of rules, rather than a constant. * Passing invalid query parameters to Manager methods will now cause a fatal error. * Scalar references now work correctly when used in IN(...) queries built by QueryBuilder. (Patch by Perrin Harkins) * Fixed a bug that caused get_set_on_save methods to fail for certain kinds of ...-to-one relationships. * Ignore empty "and" and "or" query parameters in QueryBuilder. (Suggested by Jonathan Vanasco) * Fixed a bug that caused update() to fail for tables where all columns are part of the primary key. (Reported by Danial Pearce) * Minor tweaks to the subselect-based limit/offset code. 0.742 (07.21.2006) - John Siracusa * Added support for a more efficient subselect-based limit/offset implementation for queries that would otherwise have to be scanned through manually. * Added a column class for PostgreSQL's BYTEA column type. * Added support for DBI bind_param() attributes for all column types. * Fixed a bug in the test suite that could cause the TIME(9) column type test to fail in PostgreSQL. * Fixed some POD formatting errors. 0.741 (07.14.2006) - John Siracusa * Added end_of_month_mode parameter to the interval column class. * Prevented perl_* code generation methods from attempting to auto-initialize missing metadata. * Added name/value pair, JSON, and YAML helper methods. * Tweaked the JOIN syntax for MySQL in order to better accommodate MySQL version 5.0.12+. (Reported by Glenn Gallien) * Some small POD corrections. 0.74 (06.30.2006) - John Siracusa * Added the Time column type. * Added support for the changes_only parameter to the insert() method. * Documented the manager_base_class(es) Loader methods. * Fixed a bug that caused the Loader to refuse to use empty or undefined class_prefix values. * Fixed a bug that prevented auto_* methods names from working in calls to the setup() method. * Removed redundant @ISA declaration from generated Manager classes. 0.731 (06.12.2006) - John Siracusa * Fixed a database handle leak in the get_objects_iterator() method. (Reported by Martin Rubli) * Documented the changes_only parameter to the save() and update() methods. (This feature was actually implemented in version 0.73, but I forgot to document it.) * The class_for() metadata method may now be called as a class method, with some caveats. 0.73 (06.07.2006) - John Siracusa * The new setup() method is now the officially recommended way to set up class metadata. * Updated the documentation and the generated Perl code to use the new setup() method. * Related classes are now loaded automatically by default. Added the auto_load_related_classes metadata attribute to control this behavior. * Added the pk_columns() alias for the primary_key_columns() method. * Added insert_or_update() and insert_or_update_on_duplicate_key() helper methods. (Suggested by Guillermo Roditi) * The Loader now automatically skips tables without primary keys. * Moved some database introspection code to a new version of Rose::DB, which this version of Rose::DB::Object now requires. * Non-null character columns are now detected correctly in Informix. * Fixed many bugs related to explicit and auto-detected column defaults. * Corrected the return value of Rose::DB::Object::Cached's load() method to match that of the standard load(). (Reported by Randal Schwartz) * Fixed a bug that caused chkpass columns to be erased after some save()s. (Reported by Cees Hek) * Added an option to use InnoDB with MySQL in the benchmark suite. 0.727 (05.24.2006) - John Siracusa * Fixed a bug that caused custom primary key sequences to be improperly configured in the code generated by the perl_class_defintion() method. (Reported by Ethan Rowe) * Fixed a bug that caused false boolean values to be ignored when an object was loaded, modified, and then saved. (Patch by Cees Hek) 0.726 (05.17.2006) - John Siracusa * Fixed incorrect skip count in t/spot-check-07.t 0.725 (05.17.2006) - John Siracusa * Fixed a bug that caused self-referential many-to-many relationships to fail during cascaded save() operations. (Reported by Michael Drozdov) * The test suite now requires DBD::SQLite version 1.11 or later. * Modified auto-init system to account for custom FetchHashKeyName DBI settings. 0.724 (05.11.2006) - John Siracusa * Added the replace_column() Metadata method. * The add_now and add_on_save relationship methods now return the number of items added when called in scalar context and the list of items added when called in list context. (Suggested by Jesse Brown) 0.723 (05.07.2006) - John Siracusa * Fixed a bug that caused Rose::DB::Object::Cached objects to stay in the cache after being delete()d. * Added clone() and clone_and_reset() Helper methods. * The tutorial now recommends "use base ..." over direct modification of @ISA in order to work better with circular relationships. * Generated Perl code now uses "use base ..." for the same reason. * Simplified object destruction, delegating all database object clean-up to Rose::DB. 0.722 (04.27.2006) - John Siracusa * Really remove Clone::PP this time... 0.721 (04.27.2006) - John Siracusa * Improved and documented metadata inheritance behavior. 0.72 (04.19.2006) - John Siracusa * Many reference-count bugs fixed, including several that could cause database handles to leak. * Fixed a bug that could cause "empty" sub-objects to be created when processing certain with_objects parameters. * Improved the accessor/mutator methods for these column types: set, array, and boolean. * Changed the BigInt and BigSerial column classes to use normal Perl scalars instead of Math::BigInt objects when perl has been compiled to use native 64-bit integers. (Suggested by Jesse Brown) * Added the inject_results Manager parameter to bypass the standard object creation mechanism in cases where it's the dominant factor in overall performance. 0.71 (04.14.2006) - John Siracusa * Correctly clear the "in the database" state flag when a speculative load fails because the object was not found. (Reported indirectly by Svilen Ivanov) * Changed how multi-table queries are formulated for SQLite in order to make the new DBD::SQLite version (1.12) happy. * Fixed errors in the epoch column documentation. * Fixed some internal method-maker bugs. 0.701 (04.05.2006) - John Siracusa * Removed stray "._*" files from module distribution. 0.70 (04.04.2006) - John Siracusa * Added support for the interval data type. * Added support for big integer and serial columns via Math::BigInt. * Added explicit support for columns that store a number of seconds since the Unix epoch (both integer and fractional). * Silenced warning when querying datetime columns with undef values. * Fixed a bug in the loader that prevented auto-generated base class names from being correctly nested under class_prefix. * Fixed a bug that caused duplicate WHERE clauses when a relationship name was the same as the foreign table name. 0.691 (03.16.2006) - John Siracusa * Fixed a bug that prevented the Manager from correctly handling many-to-one relationships in some situations. (Reported by Michael Lackhoff) 0.69 (03.12.2006) - John Siracusa * Added Rose::DB::Object::MixIn and Rose::DB::Object::Helpers. * Made insert() and update() part of Rose::DB::Object's public API. * Fixed typos in some auto-initialization error messages. * Improved checks for MySQL transaction support in the test suite. 0.681 (02.16.2006) - John Siracusa * Removed debugging trigger accidentally left in the 0.68 release. 0.68 (02.16.2006) - John Siracusa * Added support for literal query values using scalar references. * Added translation of undef to the inline keyword NULL in multi-value query operations. (Reported by Teodor Zlatanov) * Added the default_load_speculative() metadata attribute. (Suggested by Teodor Zlatanov) * Added a referential_integrity() attribute to foreign keys and ?-to-one relationships. (Suggested by Teodor Zlatanov) * Corrected some errors in the documentation and added more details on the auto-initialization of relationships. 0.67 (02.07.2006) - John Siracusa * Added the ability to directly set attributes in map records when saving the parent object. (Suggested by Bruno Czekay) * Slightly rearranged and added to the tutorial. 0.66 (02.02.2006) - John Siracusa * Disabled implicit primary table sort clause in the Manager when only fetching rows from a single table. * Allow multiple pre_init_hook()s in the loader and metadata object. * Improved auto-initialization of many-to-many relationships. * Added with_relationships, with_foreign_keys, with_unique_keys, db, and db_class parameters to make_classes() and the loader object. * Renamed some obscure convention manager methods and altered the default behavior of the is_map_class() method slightly. 0.65 (01.27.2006) - John Siracusa * More MySQL 5 bitfield fixes. (Reported by Svilen Ivanov) Important note: if you are using MySQL 5.0.3 or later and you have one or more BIT columns in a given table, you MUST call meta->allow_inline_column_values(1) when setting up the Rose::DB::Object-derived class that fronts the table. * Added missing "use ..." statements to the code generated by perl_class_definition(). * Fixed a bug that prevented certain kinds of self-referential relationships from being initialized properly. (Reported by Bruno Czekay) 0.64 (01.19.2006) - John Siracusa * Worked around yet more SQLite ORDER BY bugs. * Improved the column trigger implementation. * Added support for MySQL 5's brain-dead new BIT column type. Classes must allow_inline_column_values(1) to use it due to the inability of DBD::mysql to bind BIT values correctly without explicit calls to DBI's bind_param() method. * Use alternate strategies for extracting foreign key information from MySQL 5 because the old way no longer works reliably. 0.63 (01.15.2006) - John Siracusa * Made the with_map_records Manager argument work in the manager_args list for relationships. * Added the generate_manager_class_name() method to the loader. * Added the auto_manager_class_name() method to convention manager, and made the loader delegate to it. 0.62 (01.06.2006) - John Siracusa * Fixed a make_modules() bug that caused incorrect init_db() methods to be created in some cases. (Reported by Sean Davis) 0.61 (01.05.2006) - John Siracusa * Added "select" parameter to the Manager which accetps an explicit list of columns to be selected. * It's now possible to filter based on columns that are not selected as part of a Manager query. * Extra parameters can now be passed to the method created by make_manager_method_from_sql() * Fixed several bitfield column accessor method bugs. (Reported by Svilen Ivanov) * The loader's make_modules() method now correctly creates *.pm files for auto-generated base classes. (Reported by Sean Davis) 0.601 (01.01.2006) - John Siracusa * Fixed some incorrect deep join tests. * Reduced the number of PostgreSQL database connections used in the test suite in order to avoid hitting PostgreSQL's default connection limit. * Fixed the DBI benchmark tests broken by the last release. * Uncommented some sections of the benchmark script that were accidentally left commented-out in the last release. 0.60 (12.31.2005) - John Siracusa * Added arbitrary-depth auto-joins to the Manager using a "dot-chained" syntax (e.g., vendor.regions.code) * Added make_modules() method to the loader. * Added pre_init_hook() method to metadata objects and the loader. * Added overflow attribute to control the behavior when a scalar, character, or varchar column value is too long. Possible values are "fatal" (the default), "truncate", and "warn". * Serial columns are now detected correctly even when DBI returns a column type of integer or bigint. (Reported by Cees Hek) * Added support for bigserial columns. * Enum columns now have their list of valid values printed correctly by the perl_hash_definition() method. (Reported by Juan Camacho) * Fixed a bug that caused the loader to trip over mixed-case unique keys in MySQL databases. (Reported by Juan Camacho) * Force MDY dates in PostgreSQL in the test suite, just in case the user has European dates configured. (Reported by Cees Hek) * Fixed numerous PostgreSQL 7.x bugs. (Reported by Cees Hek) * Modified the benchmark suite to further confine each module to its own private set of database rows in order to eliminate the influence of run order during the tests. * Worked around SQLite ORDER BY bugs in order to make the test suite function correctly. 0.59 (12.19.2005) - John Siracusa * Added in_array, any_in_array, and all_in_array query operators for filtering on PostgreSQL array columns. * Fixed a bug that caused certain method overrides to fail when using a custom metadata class with the auto-initialize feature. (Reported by Svilen Ivanov) 0.58 (12.16.2005) - John Siracusa * Added auto-detection of multiple sequence-based primary key columns and primary keys with one or more non-sequence- based columns. * Added support for schema and catalog overrides. * Added tests for db migration with forced and default schemas, multiple sequence-based primary key columns, and primary keys with one or more non-sequence-based columns, migrating to and from databases with and without sequence support. (Whew!) * Added a summary of the default conventions to the Rose::DB::Object::ConventionManager documentation. 0.57 (12.04.2005) - John Siracusa * Fixed broken custom convention manager support in the loader. 0.56 (12.03.2005) - John Siracusa * Updated required Rose::DB version. The 0.55 release was incorrect. 0.55 (12.03.2005) - John Siracusa * Added get_objects_from_sql() and make_manager_method_from_sql() Manager methods. * Made the use of prepare_cached() optional everywhere. It's on by default in Rose::DB::Object, but off by default in Manager. Class data determines the defaults. * Added enum column type. 0.54 (11.30.2005) - John Siracusa * Added SQLite support. * Improved auto-detection of primary key sequence names. * Made primary key sequence names configurable. * Added the "with_map_records" Manager parameter used to fetch map records when auto-joining through a "many to many" relationship. * Fixed a bug in the MySQL foreign key auto-init system. (Reported by Bernhard Graf) * Fixed a bug in the column type class customization system that caused it to fail when combined with auto-initialization. (Reported by Bernhard Graf) * DBI 1.40 or later is now required. 0.53 (11.22.2005) - John Siracusa * Improved handling of table and column names that use reserved words. 0.52 (11.21.2005) - John Siracusa * Fixed bugs in loader when using a DSN instead of a db. 0.51 (11.20.2005) - John Siracusa * Added auto-initialization of relationships. * Added loader. 0.50 (11.17.2005) - John Siracusa * Added optional lazy-loading of column values. * Long-overdue version number bump. 0.081 (11.15.2005) - John Siracusa * Tutorial added. 0.080 (11.14.2005) - John Siracusa * Added column triggers for get, set, load, save, inflate, and deflate. * Added support for new argument types to relationship methods. * Added a named, configurable map for convention manager classes. * Added perl_manager_class() and make_manager_class() meta methods. * Many bug fixes to datetime column methods, cross-database migration, and the auto-init system. 0.079 (10.25.2005) - John Siracusa * Fixed bugs that caused auto-inited many-to-many relationships to be inadequately fleshed-out under some circumstances. 0.078 (10.24.2005) - John Siracusa * Added page and per_page manager parameters for the truly lazy. * Fixed a bug caused by a conflict between the convention manager and the legacy foreign key name generator. 0.077 (10.20.2005) - John Siracusa * Added convention manager. * Added "distinct" and "fetch_only" manager parameters. * Added support for foreign key and relationship names as column prefixes in manager query parameters and sort_by arguments. * Changed manager and query builder to default unprefixed ambiguous columns to belong to the primary table ("t1"). * Fixed a bug that caused make_methods() to fail for "... to one" relationships that have no corresponding foreign key. * Fixed a bug in QueryBuilder that prevented the ability to check for null columns. * Added the ability to query columns that are not SELECTed. 0.076 (10.05.2005) - John Siracusa * Fixed a bug that caused incorrect counts in get_objects_count() when using the require_object parameter with "... to many" relationships. * Added bulk update and delete methods to Manager. * Added cascaded delete, plus a plea in the documentation for users to do this in the database instead. * Added "many to one" relationship and made it the new default relationship type for foreign keys. * Added *_now and *_on_save method types for foreign keys and "... to one" relationships. * Made get_set_on_save and delete_on_save the default auto method types for foreign keys and "... to one" relationships. * load() now returns the object itself on success, which allows for the convenient $obj = MyObject->new(id => 123)->load; * save() now returns the object itself on success, which allows for the convenient $obj = MyObject->new(id => 123)->save; 0.075 (09.19.2005) - John Siracusa * Added support for "many to many" relationships to Manager's "with_objects" and "require_objects" parameters. * Corrected a bug that could cause missing sub-objects when using the Manager's "with_objects" and "require_objects" parameters. * Added warning for doing multiple LEFT OUTER JOINs that could cause a geometric explosion of redundant rows. * Added the "multi_many_ok" parameter to Manager to suppress the warning described above. * Forced inner joins when fetching foreign keys that have key columns that are all NOT NULL. * Added a few more sanity checks to class setup which, in turn, helped me to find and fix a few bugs in the test suite. 0.074 (09.15.2005) - John Siracusa * Repurposed the "with_objects" Manager parameter to do explicit LEFT OUTER JOINs instead of implicit inner joins. * Added "require_objects" Manager parameter to fill the old role of the "with_objects" parameter. * Documented new restrictions associated with the more sensible "with_objects" and "require_objects" parameters. * Added *_sql comparison operators to QueryBuilder, allowing inline SQL. (Requested by Uwe Voelker.) * Removed restriction on aliasing primary key columns. * Fixed bug in Manager that caused fetched objects to be inserted instead of updated on save(). (Reported by Uwe Voelker.) * Corrected a misspelled method name in Rose::DB::Object::Cached. (Reported by David Glass) * Updated benchmark suite to include "one to many" search tests. 0.073 (09.09.2005) - John Siracusa * Added deferred method creation for relationships and foreign keys in order to make "many to many" relationship setup more developer-friendly. * Renamed default auto-method type for foreign keys and relationships from "get" to "get_set", since technically these foreign objects can be set. They just don't go into the database at that point. I'll probably use a different term for that process (e.g., "add") * Some POD and test fixes. 0.0721 (09.08.2005) - John Siracusa * Fixed incorrect method names in Numeric column type. * Added tests to prevent the above error in the future. 0.072 (08.31.2005) - John Siracusa * Added "get" and "set" interfaces to all default column method makers. * More POD fixes. 0.071 (08.30.2005) - John Siracusa * POD fixes. 0.07 (08.30.2005) - John Siracusa * Added rudimentary "many to many" relationship support. * Restructured method-making system to support extensible method types for each kind of thing that makes methods. * Added "get" and "set" interfaces to the scalar method maker. 0.0692 (08.20.2005) - John Siracusa * POD fixes. 0.069 (08.20.2005) - John Siracusa * Whoops, fixed manifest to repair a botched 0.068 release. 0.068 (08.19.2005) - John Siracusa * Enabled multiple joins with the same table in the manager, provided that each occurrence of multi-joined table has the same Rose::DB::Object class fronting it. * Added support for the "alias" parameter to hash-style column definitions. * Added "relationship" objects. * Fixed a bug that caused nearly everything to fail if a column_name_to_method_name_mapper was used. * Moved some class methods out of the object methods section of the documentation, where they shouldn't have been in the first place. 0.0671 (08.15.2005) - John Siracusa * Fixed more MySQL case sensitivity bugs. (Thanks Uwe!) * Changed objects_by_key query_args parameter to be an array ref instead of a hash ref to match the manager change from long ago. * Updated makemethods.t to use MySQL if PostgreSQL is not available. 0.067 (08.14.2005) - John Siracusa * Fixed more MySQL bugs related to foreign keys, timestamps, and boolean support in MySQL 4.0.x. 0.066 (08.12.2005) - John Siracusa * Fixed MySQL case-sensitivity bug. * Added case-sensitivity tests for PostgreSQL and MySQL. * Added accessor, delete, and search with limit and offset benchmarks. 0.0651 (08.11.2005) - John Siracusa * Moved benchmarks into test directory in an attempt to get search.cpan.org to ignore them. 0.065 (08.11.2005) - John Siracusa * Improved the efficiency of manager classes. * Added benchmark suite. * More POD fixes. 0.064 (08.09.2005) - John Siracusa * Duh, forgot the table name and initialize() call in perl_class_definition(). 0.063 (08.09.2005) - John Siracusa * Added foreign key auto-initialization for Informix. 0.062 (08.08.2005) - John Siracusa * Changed default error mode to "fatal" for manager class too. 0.061 (08.07.2005) - John Siracusa * Added foreign key auto-initialization for MySQL. 0.06 (08.05.2005) - John Siracusa * Added auto-initialization (finally). * Plumped-up unique and primary keys into objects. * Changed default error mode to "fatal" * Made substantial additions to the documentation. 0.052 (07.22.2005) - John Siracusa * Added make_manager_methods() to Rose::DB::Object::Manager. * Corrected Rose::DB::Object::Manager POD. 0.052 (07.22.2005) - John Siracusa * Added make_manager_methods() to Rose::DB::Object::Manager. * Corrected Rose::DB::Object::Manager POD. 0.051 (06.22.2005) - John Siracusa * Added abstracted offset parameter to object manager. 0.05 (06.16.2005) - John Siracusa * Moved object cache management further into the metadata object. * Enabled auto-generated primary key values for Rose::DB::Object objects used with the PostgreSQL database. 0.043 (06.16.2005) - John Siracusa * Added time-based expiration to Rose::DB::Object::Cached. * Added catalog attribute to metadata objects. 0.042 (05.04.2005) - John Siracusa * Added not_null attribute to column metadata objects. * Removed use of prepare_cached() because it apparently(?) can't be used across transactions in Informix. 0.041 (04.22.2005) - John Siracusa * Corrected typo in DatetimeYearToSecond column class. (Still need to add tests for those column types...) * Added skip_first parameter to get_object_iterator(). * Added fix to avoid trying to format or truncate undefined dates in datetime columns. 0.04 (04.01.2005) - John Siracusa * Refactored column value parsing. No, really. 0.031 (03.27.2005) - John Siracusa * Corrected typos and errors in the documentation. 0.03 (03.27.2005) - John Siracusa * Added error_mode methods. 0.023 (03.25.2005) - John Siracusa * Added prepare_*_options (undocumented for now). 0.022 (03.18.2005) - John Siracusa * Fixed POD error that was throwing off search.cpan.org. 0.021 (03.17.2005) - John Siracusa * Added documentation for the "pretty" parameter to build_select() * Added support for column value inlining in build_select() 0.02 (03.17.2005) - John Siracusa * Added support for nested boolean logic in queries. 0.013 (03.11.2005) - John Siracusa * Fixed bug in Rose::DB::Object::Std::Metadata that caused the number of primary key columns to appear to be zero. 0.012 (03.10.2005) - John Siracusa * Add tests for aliased unique key fix and primary key aliasing. Documented constraints on column aliasing. Fixed version numbers in this file. Deleted version 0.011. 0.011 (03.09.2005) - John Siracusa * Well that was quick. Fixed copy and paste error that caused a failure to load using an aliased unique key column. Deleted version 0.01. 0.01 (03.09.2005) - John Siracusa * Initial release. Rose-DB-Object-0.810/lib/000750 000765 000120 00000000000 12266514754 014761 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/Makefile.PL000755 000765 000120 00000004137 11507154330 016165 0ustar00johnadmin000000 000000 require 5.006; use ExtUtils::MakeMaker; my $MM_Version = $ExtUtils::MakeMaker::VERSION; if($MM_Version =~ /_/) # dev version { $MM_Version = eval $MM_Version; die $@ if($@); } WriteMakefile(NAME => 'Rose::DB::Object', ABSTRACT_FROM => 'lib/Rose/DB/Object.pm', VERSION_FROM => 'lib/Rose/DB/Object.pm', ($^O =~ /darwin/i ? (dist => { DIST_CP => 'cp' }) : ()), # Avoid Mac OS X ._* files PREREQ_PM => { 'Cwd' => 0, 'Data::Dumper' => '2.121', 'File::Path' => 0, 'File::Spec' => 0, 'DBI' => '1.40', 'DateTime' => 0, 'Time::Clock' => '1.00', 'Test::More' => 0, 'Bit::Vector' => 0, 'Scalar::Util' => 0, 'List::MoreUtils' => 0, 'Math::BigInt' => '1.77', 'Clone' => '0.29', #'Scalar::Util::Clone' => '0.04', 'Rose::DateTime::Util' => '0.532', 'Rose::Object' => '0.854', 'Rose::DB' => '0.763', }, clean => { FILES => "t/*.db" }, AUTHOR => 'John Siracusa ', ($MM_Version >= 6.48 ? (MIN_PERL_VERSION => '5.6.0') : ()), ($MM_Version >= 6.31 ? (LICENSE => 'perl') : ()), ($MM_Version <= 6.44 ? () : (META_MERGE => { resources => { license => 'http://dev.perl.org/licenses/', homepage => 'http://rose.googlecode.com/', bugtracker => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Rose-DB-Object', repository => 'http://rose.googlecode.com/svn/trunk/modules/Rose-DB-Object', MailingList => 'http://groups.google.com/group/rose-db-object', }, }))); Rose-DB-Object-0.810/MANIFEST000644 000765 000120 00000020210 12266514755 015345 0ustar00johnadmin000000 000000 Changes lib/Rose/DB/Object.pm lib/Rose/DB/Object/Cached.pm lib/Rose/DB/Object/Constants.pm lib/Rose/DB/Object/ConventionManager.pm lib/Rose/DB/Object/ConventionManager/Null.pm lib/Rose/DB/Object/Exception.pm lib/Rose/DB/Object/Helpers.pm lib/Rose/DB/Object/Iterator.pm lib/Rose/DB/Object/Loader.pm lib/Rose/DB/Object/MakeMethods/BigNum.pm lib/Rose/DB/Object/MakeMethods/Date.pm lib/Rose/DB/Object/MakeMethods/Generic.pm lib/Rose/DB/Object/MakeMethods/Pg.pm lib/Rose/DB/Object/MakeMethods/Std.pm lib/Rose/DB/Object/MakeMethods/Time.pm lib/Rose/DB/Object/Manager.pm lib/Rose/DB/Object/Metadata.pm lib/Rose/DB/Object/Metadata/Auto.pm lib/Rose/DB/Object/Metadata/Auto/Generic.pm lib/Rose/DB/Object/Metadata/Auto/Informix.pm lib/Rose/DB/Object/Metadata/Auto/MySQL.pm lib/Rose/DB/Object/Metadata/Auto/Oracle.pm lib/Rose/DB/Object/Metadata/Auto/Pg.pm lib/Rose/DB/Object/Metadata/Auto/SQLite.pm lib/Rose/DB/Object/Metadata/Column.pm lib/Rose/DB/Object/Metadata/Column/Array.pm lib/Rose/DB/Object/Metadata/Column/BigInt.pm lib/Rose/DB/Object/Metadata/Column/BigSerial.pm lib/Rose/DB/Object/Metadata/Column/Bitfield.pm lib/Rose/DB/Object/Metadata/Column/Blob.pm lib/Rose/DB/Object/Metadata/Column/Boolean.pm lib/Rose/DB/Object/Metadata/Column/Pg/Bytea.pm lib/Rose/DB/Object/Metadata/Column/Character.pm lib/Rose/DB/Object/Metadata/Column/Date.pm lib/Rose/DB/Object/Metadata/Column/Datetime.pm lib/Rose/DB/Object/Metadata/Column/DatetimeYearToFraction.pm lib/Rose/DB/Object/Metadata/Column/DatetimeYearToFraction1.pm lib/Rose/DB/Object/Metadata/Column/DatetimeYearToFraction2.pm lib/Rose/DB/Object/Metadata/Column/DatetimeYearToFraction3.pm lib/Rose/DB/Object/Metadata/Column/DatetimeYearToFraction4.pm lib/Rose/DB/Object/Metadata/Column/DatetimeYearToFraction5.pm lib/Rose/DB/Object/Metadata/Column/DatetimeYearToMinute.pm lib/Rose/DB/Object/Metadata/Column/DatetimeYearToMonth.pm lib/Rose/DB/Object/Metadata/Column/DatetimeYearToSecond.pm lib/Rose/DB/Object/Metadata/Column/Decimal.pm lib/Rose/DB/Object/Metadata/Column/DoublePrecision.pm lib/Rose/DB/Object/Metadata/Column/Enum.pm lib/Rose/DB/Object/Metadata/Column/Epoch.pm lib/Rose/DB/Object/Metadata/Column/Epoch/HiRes.pm lib/Rose/DB/Object/Metadata/Column/Float.pm lib/Rose/DB/Object/Metadata/Column/Integer.pm lib/Rose/DB/Object/Metadata/Column/Interval.pm lib/Rose/DB/Object/Metadata/Column/Numeric.pm lib/Rose/DB/Object/Metadata/Column/Pg/Chkpass.pm lib/Rose/DB/Object/Metadata/Column/Scalar.pm lib/Rose/DB/Object/Metadata/Column/Serial.pm lib/Rose/DB/Object/Metadata/Column/Set.pm lib/Rose/DB/Object/Metadata/Column/Text.pm lib/Rose/DB/Object/Metadata/Column/Time.pm lib/Rose/DB/Object/Metadata/Column/Timestamp.pm lib/Rose/DB/Object/Metadata/Column/TimestampWithTimeZone.pm lib/Rose/DB/Object/Metadata/Column/Varchar.pm lib/Rose/DB/Object/Metadata/ColumnList.pm lib/Rose/DB/Object/Metadata/ForeignKey.pm lib/Rose/DB/Object/Metadata/MethodMaker.pm lib/Rose/DB/Object/Metadata/Object.pm lib/Rose/DB/Object/Metadata/PrimaryKey.pm lib/Rose/DB/Object/Metadata/Relationship.pm lib/Rose/DB/Object/Metadata/Relationship/ManyToMany.pm lib/Rose/DB/Object/Metadata/Relationship/ManyToOne.pm lib/Rose/DB/Object/Metadata/Relationship/OneToMany.pm lib/Rose/DB/Object/Metadata/Relationship/OneToOne.pm lib/Rose/DB/Object/Metadata/UniqueKey.pm lib/Rose/DB/Object/Metadata/Util.pm lib/Rose/DB/Object/MixIn.pm lib/Rose/DB/Object/QueryBuilder.pm lib/Rose/DB/Object/Std.pm lib/Rose/DB/Object/Std/Cached.pm lib/Rose/DB/Object/Std/Metadata.pm lib/Rose/DB/Object/Tutorial.pod lib/Rose/DB/Object/Util.pm Makefile.PL MANIFEST t/00-warning.t t/as-tree.t t/auto-setup.t t/benchmarks/bench.pl t/benchmarks/lib/MyTest/CDBI/Base.pm t/benchmarks/lib/MyTest/CDBI/Complex/Category.pm t/benchmarks/lib/MyTest/CDBI/Complex/Code.pm t/benchmarks/lib/MyTest/CDBI/Complex/CodeName.pm t/benchmarks/lib/MyTest/CDBI/Complex/Product.pm t/benchmarks/lib/MyTest/CDBI/Simple/Category.pm t/benchmarks/lib/MyTest/CDBI/Simple/Code.pm t/benchmarks/lib/MyTest/CDBI/Simple/CodeName.pm t/benchmarks/lib/MyTest/CDBI/Simple/Product.pm t/benchmarks/lib/MyTest/CDBI/Sweet/Base.pm t/benchmarks/lib/MyTest/CDBI/Sweet/Complex/Category.pm t/benchmarks/lib/MyTest/CDBI/Sweet/Complex/Code.pm t/benchmarks/lib/MyTest/CDBI/Sweet/Complex/CodeName.pm t/benchmarks/lib/MyTest/CDBI/Sweet/Complex/Product.pm t/benchmarks/lib/MyTest/CDBI/Sweet/Simple/Category.pm t/benchmarks/lib/MyTest/CDBI/Sweet/Simple/Code.pm t/benchmarks/lib/MyTest/CDBI/Sweet/Simple/CodeName.pm t/benchmarks/lib/MyTest/CDBI/Sweet/Simple/Product.pm t/benchmarks/lib/MyTest/DBIC/Schema.pm t/benchmarks/lib/MyTest/DBIC/Schema/Complex/Category.pm t/benchmarks/lib/MyTest/DBIC/Schema/Complex/Code.pm t/benchmarks/lib/MyTest/DBIC/Schema/Complex/CodeName.pm t/benchmarks/lib/MyTest/DBIC/Schema/Complex/Product.pm t/benchmarks/lib/MyTest/DBIC/Schema/Simple/Category.pm t/benchmarks/lib/MyTest/DBIC/Schema/Simple/Code.pm t/benchmarks/lib/MyTest/DBIC/Schema/Simple/CodeName.pm t/benchmarks/lib/MyTest/DBIC/Schema/Simple/Product.pm t/benchmarks/lib/MyTest/RDBO/Complex/Category.pm t/benchmarks/lib/MyTest/RDBO/Complex/Category/Manager.pm t/benchmarks/lib/MyTest/RDBO/Complex/Code.pm t/benchmarks/lib/MyTest/RDBO/Complex/CodeName.pm t/benchmarks/lib/MyTest/RDBO/Complex/Product.pm t/benchmarks/lib/MyTest/RDBO/Complex/Product/Manager.pm t/benchmarks/lib/MyTest/RDBO/Simple/Category.pm t/benchmarks/lib/MyTest/RDBO/Simple/Category/Manager.pm t/benchmarks/lib/MyTest/RDBO/Simple/Code.pm t/benchmarks/lib/MyTest/RDBO/Simple/CodeName.pm t/benchmarks/lib/MyTest/RDBO/Simple/Product.pm t/benchmarks/lib/MyTest/RDBO/Simple/Product/Manager.pm t/bind-param.t t/column-triggers.t t/column-values.t t/db-migration.t t/db-object-auto.t t/db-object-cached.t t/db-object-changes-only-1.t t/db-object-changes-only-2.t t/db-object-convention.t t/db-object-foreign-key-auto.t t/db-object-foreign-key.t t/db-object-helpers.t t/db-object-loader.t t/db-object-loader-2.t t/db-object-loader-3.t t/db-object-loader-4.t t/db-object-loader-5.t t/db-object-loader-6.t t/db-object-loader-7.t t/db-object-loader-8.t t/db-object-loader-9.t t/db-object-manager-bulk-ops.t t/db-object-manager.t t/db-object-mapper.t t/db-object-metadata.t t/db-object-relationship.t t/db-object-relationship-auto.t t/db-object-relationship-auto-2.t t/db-object-std-cached.t t/db-object-std.t t/db-object.t t/deep-joins.t t/inheritance.t t/lazy-columns.t t/leaks.t t/lib/My/DB/Gene/Main.pm t/lib/My/DB/Gene2Unigene.pm t/lib/My/DB/Object.pm t/lib/My/DB/Unigene/Main.pm t/lib/My/DB/Opa.pm t/lib/My/DB/Opa/Object.pm t/makemethods-db.t t/makemethods.t t/make-modules.ext t/make-modules.t t/map-record-name-conflict.pl t/multi-many-the-hard-way.t t/multi-pk-sequences.t t/nested-joins.t t/one-to-many-reset.t t/pk-fk-columns.t t/pod.t t/query-builder.t t/rt-cpan-45836.t t/save-cascade.t t/sandbox/code-gen/generated-perl-test.pl t/sandbox/code-gen/lib/.placeholder t/sandbox/code-gen/make-modules.pl t/sandbox/convention/convention-test-auto.pl t/sandbox/convention/convention-test-loader.pl t/sandbox/convention/convention-test.pl t/sandbox/convention/lib/My/Auto/Color.pm t/sandbox/convention/lib/My/Auto/Price.pm t/sandbox/convention/lib/My/Auto/Product.pm t/sandbox/convention/lib/My/Auto/ProductColors.pm t/sandbox/convention/lib/My/Auto/Vendor.pm t/sandbox/convention/lib/My/Color.pm t/sandbox/convention/lib/My/DB.pm t/sandbox/convention/lib/My/Object.pm t/sandbox/convention/lib/My/Price.pm t/sandbox/convention/lib/My/Product.pm t/sandbox/convention/lib/My/ProductColors.pm t/sandbox/convention/lib/My/Region.pm t/sandbox/convention/lib/My/Vendor.pm t/sandbox/schema-clash/lib/Alpha.pm t/sandbox/schema-clash/lib/Beta.pm t/sandbox/schema-clash/sql/alpha.sql t/sandbox/schema-clash/sql/beta.sql t/sandbox/schema-clash/sql/databases.sql t/sandbox/schema-clash/t/one.t t/sandbox/schema-clash/t/two.t t/sandbox/schema-clash/test.pl t/schema-override.t t/spot-check-01.t t/spot-check-02.t t/spot-check-03.t t/spot-check-04.t t/spot-check-05.t t/spot-check-06.t t/spot-check-07.t t/spot-check-08.t t/spot-check-09.t t/spot-check-10.t t/spot-check-11.t t/spot-check-12.t t/spot-check-13.t t/spot-check-14.t t/test-lib.pl t/undef-overrides-default.t t/unique-key-prefs.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Rose-DB-Object-0.810/META.json000660 000765 000120 00000003543 12266514755 015645 0ustar00johnadmin000000 000000 { "abstract" : "Extensible, high performance object-relational mapper (ORM).", "author" : [ "John Siracusa " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.84, CPAN::Meta::Converter version 2.133380", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Rose-DB-Object", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Bit::Vector" : "0", "Clone" : "0.29", "Cwd" : "0", "DBI" : "1.40", "Data::Dumper" : "2.121", "DateTime" : "0", "File::Path" : "0", "File::Spec" : "0", "List::MoreUtils" : "0", "Math::BigInt" : "1.77", "Rose::DB" : "0.763", "Rose::DateTime::Util" : "0.532", "Rose::Object" : "0.854", "Scalar::Util" : "0", "Test::More" : "0", "Time::Clock" : "1.00", "perl" : "5.006000" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "http://rt.cpan.org/NoAuth/Bugs.html?Dist=Rose-DB-Object" }, "homepage" : "http://rose.googlecode.com/", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "http://rose.googlecode.com/svn/trunk/modules/Rose-DB-Object" }, "x_MailingList" : "http://groups.google.com/group/rose-db-object" }, "version" : "0.810" } Rose-DB-Object-0.810/META.yml000660 000765 000120 00000002125 12266514755 015470 0ustar00johnadmin000000 000000 --- abstract: 'Extensible, high performance object-relational mapper (ORM).' author: - 'John Siracusa ' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.84, CPAN::Meta::Converter version 2.133380' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Rose-DB-Object no_index: directory: - t - inc requires: Bit::Vector: 0 Clone: 0.29 Cwd: 0 DBI: 1.40 Data::Dumper: 2.121 DateTime: 0 File::Path: 0 File::Spec: 0 List::MoreUtils: 0 Math::BigInt: 1.77 Rose::DB: 0.763 Rose::DateTime::Util: 0.532 Rose::Object: 0.854 Scalar::Util: 0 Test::More: 0 Time::Clock: 1.00 perl: 5.006000 resources: MailingList: http://groups.google.com/group/rose-db-object bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Rose-DB-Object homepage: http://rose.googlecode.com/ license: http://dev.perl.org/licenses/ repository: http://rose.googlecode.com/svn/trunk/modules/Rose-DB-Object version: 0.810 Rose-DB-Object-0.810/t/000750 000765 000120 00000000000 12266514755 014457 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/00-warning.t000755 000765 000120 00000006662 12266514254 016542 0ustar00johnadmin000000 000000 #!/usr/bin/perl use strict; sub nvl { defined $ENV{$_[0]} ? $ENV{$_[0]} : $_[1] } eval { require DBI }; eval { require DBD::Pg }; eval { require DBD::mysql }; eval { require DBD::SQLite }; eval { require DBD::Informix }; eval { require DBD::Oracle }; eval { require JSON }; print STDERR "\n##\n"; foreach my $pkg (qw(DBI DBD::Pg DBD::mysql DBD::SQLite DBD::Informix DBD::Oracle JSON)) { no strict 'refs'; if(defined(my $version = ${$pkg . '::VERSION'})) { print STDERR sprintf("## %-15s $version\n", $pkg); } } print STDERR<<"EOF"; ## ## WARNING: Almost all the tests in this module distribution need to connect ## to a database in order to run. The tests need full privileges on this ## database: the ability to create and drop tables, insert, update, and delete ## rows, create schemas, sequences, functions, triggers, the works. ## ## By default, the tests will try to connect to the database named "test" ## running on "localhost" using the default superuser username for each ## database type and an empty password. ## ## If you have setup your database in a secure manner, these connection ## attempts will fail, and the tests will be skipped. If you want to override ## these values, set the following environment variables before running tests. ## (The current values are shown in parentheses.) ## ## PostgreSQL: ## ## RDBO_PG_DSN (@{[ nvl('RDBO_PG_DSN', 'dbi:Pg:dbname=test;host=localhost') ]}) ## RDBO_PG_USER (@{[ nvl('RDBO_PG_USER', 'postgres') ]}) ## RDBO_PG_PASS (@{[ nvl('RDBO_PG_PASS', '') ]}) ## ## MySQL: ## ## RDBO_MYSQL_DSN (@{[ nvl('RDBO_MYSQL_DSN', 'dbi:mysql:database=test;host=localhost') ]}) ## RDBO_MYSQL_USER (@{[ nvl('RDBO_MYSQL_USER', 'root') ]}) ## RDBO_MYSQL_PASS (@{[ nvl('RDBO_MYSQL_PASS', '') ]}) ## ## Oracle: ## ## RDBO_ORACLE_DSN (@{[ nvl('RDBO_ORACLE_DSN', 'dbi:Oracle:dbname=test') ]}) ## RDBO_ORACLE_USER (@{[ nvl('RDBO_ORACLE_USER', '') ]}) ## RDBO_ORACLE_PASS (@{[ nvl('RDBO_ORACLE_PASS', '') ]}) ## ## Informix: ## ## RDBO_INFORMIX_DSN (@{[ nvl('RDBO_INFORMIX_DSN', 'dbi:Informix:test@test') ]}) ## RDBO_INFORMIX_USER (@{[ nvl('RDBO_INFORMIX_USER', '') ]}) ## RDBO_INFORMIX_PASS (@{[ nvl('RDBO_INFORMIX_PASS', '') ]}) ## ## SQLite: To disable the SQLite tests, set this environment varible ## ## RDBO_NO_SQLITE (@{[ nvl('RDBO_NO_SQLITE', '') ]}) ## ## Press return to continue (or wait 60 seconds) EOF eval { require DBD::SQLite }; (my $version = $DBD::SQLite::VERSION || 0) =~ s/_//g; if(!$@ && ($version < 1.11 || ($version >= 1.13 && $version < 1.1902))) { print STDERR<<"EOF"; *** *** WARNING: DBD::SQLite version $DBD::SQLite::VERSION detected. Versions 1.13 and 1.14 *** are known to have serious bugs that prevent the test suite from working *** correctly. In particular: *** *** http://rt.cpan.org/Public/Bug/Display.html?id=21472 *** *** The SQLite tests will be skipped. Please install DBD::SQLite 1.12 *** or version 1.19_02 or later. *** *** Press return to continue (or wait 60 seconds) EOF } unless($ENV{'AUTOMATED_TESTING'} || $ENV{'PERL_MM_USE_DEFAULT'}) { my %old; $old{'ALRM'} = $SIG{'ALRM'} || 'DEFAULT'; eval { # Localize so I only have to restore in my catch block local $SIG{'ALRM'} = sub { die 'alarm' }; alarm(60); my $res = ; alarm(0); }; if($@ =~ /alarm/) { $SIG{'ALRM'} = $old{'ALRM'}; } } print "1..1\n", "ok 1\n"; 1; Rose-DB-Object-0.810/t/as-tree.t000755 000765 000120 00000141061 11653604702 016206 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 2 + (5 * 28) + 4; eval { require Test::Differences }; my $Have_Test_Differences = $@ ? 0 : 1; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Loader'); use_ok('Rose::DB::Object::Helpers'); } use Data::Dumper; $Data::Dumper::Sortkeys = 1; our(%Have, $Have_YAML, $Have_JSON); # # Tests # use Rose::DB::Object::Constants qw(STATE_SAVING); #$Rose::DB::Object::Manager::Debug = 1; if(defined $ENV{'RDBO_NESTED_JOINS'} && Rose::DB::Object::Manager->can('default_nested_joins')) { Rose::DB::Object::Manager->default_nested_joins($ENV{'RDBO_NESTED_JOINS'}); } my $Include = '^(?:' . join('|', qw(colors descriptions authors nicknames description_author_map product_color_map prices products vendors regions)) . ')$'; $Include = qr($Include); foreach my $db_type (qw(sqlite mysql pg pg_with_schema informix)) { SKIP: { skip("$db_type tests", 28) unless($Have{$db_type}); } next unless($Have{$db_type}); if($Have_Test_Differences) { # Test::Differences is sensitive to string/number distinctions that # SQLite and Pg exhibit and that I don't care about. if($db_type eq 'sqlite' || $db_type =~ /^pg/) { no warnings; *is_deeply = \&Test::More::is_deeply; } else { no warnings; *is_deeply = \&Test::Differences::eq_or_diff; } } Rose::DB->default_type($db_type); Rose::DB::Object::Metadata->unregister_all_classes; # Test of the subselect limit code #Rose::DB::Object::Manager->default_limit_with_subselect(1) if($db_type =~ /^pg/); my $db = Rose::DB->new; my $class_prefix = ucfirst($db_type eq 'pg_with_schema' ? 'pgws' : $db_type); my $loader = Rose::DB::Object::Loader->new( db => $db, class_prefix => $class_prefix); my @classes = $loader->make_classes(include_tables => $Include); foreach my $class (@classes) { next unless($class->isa('Rose::DB::Object')); if(my @rels = grep { !$_->is_singular } $class->meta->relationships) { foreach my $rel (@rels) { if($rel->type eq 'many to many') { $rel->manager_args({ sort_by => 't2.id' }); } else { $rel->manager_args({ sort_by => 'id' }); } } $class->meta->make_relationship_methods(replace_existing => 1); } } my $product_class = $class_prefix . '::Product'; my $manager_class = $product_class . '::Manager'; Rose::DB::Object::Helpers->import(-target_class => $product_class, qw(as_tree new_from_tree new_from_deflated_tree init_with_tree traverse_depth_first)); if($Have_JSON) { Rose::DB::Object::Helpers->import(-target_class => $product_class, qw(as_json new_from_json init_with_json)); } if($Have_YAML) { Rose::DB::Object::Helpers->import(-target_class => $product_class, qw(as_yaml new_from_yaml init_with_yaml)); } my $p1 = $product_class->new( id => 1, name => 'Kite', sale_date => '1/2/2005', vendor => { id => 1, name => 'V1', region => { id => 'DE', name => 'Germany' } }, prices => [ { price => 1.25, region => { id => 'US', name => 'America' } }, { price => 4.25, region => { id => 'DE', name => 'Germany' } }, ], colors => [ { name => 'red', description => { text => 'desc 1', authors => [ { name => 'john', nicknames => [ { nick => 'jack' }, { nick => 'sir' } ], }, { name => 'sue', nicknames => [ { nick => 'sioux' } ], }, ], }, }, { name => 'blue', description => { text => 'desc 2', authors => [ { name => 'john' }, { name => 'jane', nicknames => [ { nick => 'blub' } ], }, ], } } ]); $p1->save; my $p2 = $product_class->new( id => 2, name => 'Sled', sale_date => '2/2/2005', vendor => { id => 2, name => 'V2', region_id => 'US', vendor_id => 1 }, prices => [ { price => '5.25' } ], colors => [ { name => 'red' }, { name => 'green', description => { text => 'desc 3', authors => [ { name => 'tim' } ], } } ]); $p2->save; my $tree = $p2->as_tree; my $from_tree = $product_class->new_from_deflated_tree($tree); is_deeply($tree, $from_tree->as_tree, "as_tree -> new_from_deflated_tree -> as_tree 1 - $db_type"); is_deeply($tree, $from_tree->as_tree, "as_tree -> new_from_deflated_tree -> as_tree 2 - $db_type"); $tree = $product_class->new(id => 2)->as_tree(force_load => 1, max_depth => 0); my $check_tree = { 'id' => '2', 'name' => 'Sled', 'vendor_id' => '2', 'sale_date' => '2005-02-02 00:00:00', }; is_deeply($tree, $check_tree, "as_tree force, depth 0 - $db_type"); my $new_from_deflated_tree = $product_class->new_from_deflated_tree($tree); is_deeply($new_from_deflated_tree->as_tree, $check_tree, "new_from_deflated_tree 1 - $db_type"); if($Have_JSON) { my $json = $product_class->new(id => 2)->as_json(force_load => 1, max_depth => 0); my $new_from_json = $product_class->new_from_json($json); is_deeply($check_tree, $new_from_json->as_tree, "new_from_json 1 - $db_type"); } else { SKIP: { skip('JSON tests', 1) } } if($Have_YAML) { my $yaml = $product_class->new(id => 2)->as_yaml(force_load => 1, max_depth => 0); my $new_from_yaml = $product_class->new_from_yaml($yaml); is_deeply($check_tree, $new_from_yaml->as_tree, "new_from_yaml 1 - $db_type"); } else { SKIP: { skip('YAML tests', 1) } } $tree = $product_class->new(id => 2)->as_tree(force_load => 1, max_depth => 1); $check_tree = { 'colors' => [ { 'description_id' => '1', 'id' => '1', 'name' => 'red' }, { 'description_id' => '3', 'id' => '3', 'name' => 'green' } ], 'id' => '2', 'name' => 'Sled', 'prices' => [ { 'id' => '3', 'price' => '5.25', 'product_id' => '2', 'region_id' => 'US' } ], 'sale_date' => '2005-02-02 00:00:00', 'vendor' => { 'id' => '2', 'name' => 'V2', 'region_id' => 'US', 'vendor_id' => '1' }, 'vendor_id' => '2' }; is_deeply($tree, $check_tree, "as_tree force, depth 1 - $db_type"); $new_from_deflated_tree = $product_class->new_from_deflated_tree($tree); is_deeply($new_from_deflated_tree->as_tree, $check_tree, "new_from_deflated_tree 2 - $db_type"); if($Have_JSON) { my $json = $product_class->new(id => 2)->as_json(force_load => 1, max_depth => 1); my $new_from_json = $product_class->new_from_json($json); is_deeply($check_tree, $new_from_json->as_tree, "new_from_json 2 - $db_type"); } else { SKIP: { skip('JSON tests', 1) } } if($Have_YAML) { my $yaml = $product_class->new(id => 2)->as_yaml(force_load => 1, max_depth => 1); my $new_from_yaml = $product_class->new_from_yaml($yaml); is_deeply($check_tree, $new_from_yaml->as_tree, "new_from_yaml 2 - $db_type"); } else { SKIP: { skip('YAML tests', 1) } } $tree = $product_class->new(id => 2)->as_tree(force_load => 1, max_depth => 2); $check_tree = { 'colors' => [ { 'description' => { 'id' => '1', 'text' => 'desc 1' }, 'description_id' => '1', 'id' => '1', 'name' => 'red' }, { 'description' => { 'id' => '3', 'text' => 'desc 3' }, 'description_id' => '3', 'id' => '3', 'name' => 'green' } ], 'id' => '2', 'name' => 'Sled', 'prices' => [ { 'id' => '3', 'price' => '5.25', 'product_id' => '2', 'region' => { 'id' => 'US', 'name' => 'America' }, 'region_id' => 'US' } ], 'sale_date' => '2005-02-02 00:00:00', 'vendor' => { 'id' => '2', 'name' => 'V2', 'region_id' => 'US', 'vendor' => { 'id' => '1', 'name' => 'V1', 'region_id' => 'DE', 'vendor_id' => undef }, 'vendor_id' => '1', 'vendors' => [] }, 'vendor_id' => '2' }; is_deeply($tree, $check_tree, "as_tree force, depth 2 - $db_type"); my $new_from_tree = $product_class->new_from_deflated_tree($tree); is_deeply($new_from_tree->as_tree, $check_tree, "new_from_tree 3 - $db_type"); if($Have_JSON) { my $json = $product_class->new(id => 2)->as_json(force_load => 1, max_depth => 2); my $new_from_json = $product_class->new_from_json($json); is_deeply($check_tree, $new_from_json->as_tree, "new_from_json 3 - $db_type"); } else { SKIP: { skip('JSON tests', 1) } } if($Have_YAML) { my $yaml = $product_class->new(id => 2)->as_yaml(force_load => 1, max_depth => 2); my $new_from_yaml = $product_class->new_from_yaml($yaml); is_deeply($check_tree, $new_from_yaml->as_tree, "new_from_yaml 3 - $db_type"); } else { SKIP: { skip('YAML tests', 1) } } $tree = $product_class->new(id => 2)->as_tree(force_load => 1, max_depth => 2, allow_loops => 1); #$product_class->new(id => 2)->traverse_depth_first( # force_load => 1, handlers => # { # object => sub { print ' ' x $_[4], ref($_[0]), ': ' . $_[0]->id, "\n" } # }); $check_tree = { 'colors' => [ { 'description' => { 'id' => '1', 'text' => 'desc 1' }, 'description_id' => '1', 'id' => '1', 'name' => 'red', 'products' => [ { 'id' => '1', 'name' => 'Kite', 'sale_date' => '2005-01-02 00:00:00', 'vendor_id' => '1' }, { 'id' => '2', 'name' => 'Sled', 'sale_date' => '2005-02-02 00:00:00', 'vendor_id' => '2' } ] }, { 'description' => { 'id' => '3', 'text' => 'desc 3' }, 'description_id' => '3', 'id' => '3', 'name' => 'green', 'products' => [ { 'id' => '2', 'name' => 'Sled', 'sale_date' => '2005-02-02 00:00:00', 'vendor_id' => '2' } ] } ], 'id' => '2', 'name' => 'Sled', 'prices' => [ { 'id' => '3', 'price' => '5.25', 'product' => { 'id' => '2', 'name' => 'Sled', 'sale_date' => '2005-02-02 00:00:00', 'vendor_id' => '2' }, 'product_id' => '2', 'region' => { 'id' => 'US', 'name' => 'America' }, 'region_id' => 'US' } ], 'sale_date' => '2005-02-02 00:00:00', 'vendor' => { 'id' => '2', 'name' => 'V2', 'products' => [ { 'id' => '2', 'name' => 'Sled', 'sale_date' => '2005-02-02 00:00:00', 'vendor_id' => '2' } ], 'region' => { 'id' => 'US', 'name' => 'America' }, 'region_id' => 'US', 'vendor' => { 'id' => '1', 'name' => 'V1', 'region_id' => 'DE', 'vendor_id' => undef }, 'vendor_id' => '1', 'vendors' => [] }, 'vendor_id' => '2' }; is_deeply($tree, $check_tree, "as_tree force, depth 2, allow_loops => 1 - $db_type"); $new_from_tree = $product_class->new_from_tree($tree); is_deeply($new_from_tree->as_tree(allow_loops => 1), $check_tree, "new_from_tree 4 - $db_type"); if($Have_JSON) { my $json = $product_class->new(id => 2)->as_json(force_load => 1, max_depth => 2, allow_loops => 1); my $new_from_json = $product_class->new_from_json($json); is_deeply($check_tree, $new_from_json->as_tree(allow_loops => 1), "new_from_json 4 - $db_type"); } else { SKIP: { skip('JSON tests', 1) } } if($Have_YAML) { my $yaml = $product_class->new(id => 2)->as_yaml(force_load => 1, max_depth => 2, allow_loops => 1); my $new_from_yaml = $product_class->new_from_yaml($yaml); is_deeply($check_tree, $new_from_yaml->as_tree(allow_loops => 1), "new_from_yaml 4 - $db_type"); } else { SKIP: { skip('YAML tests', 1) } } $tree = $product_class->new(id => 2)->as_tree(force_load => 1, max_depth => 2, allow_loops => 1, prune => sub { shift->name =~ /^p/ }); $check_tree = { 'colors' => [ { 'description' => { 'id' => '1', 'text' => 'desc 1' }, 'description_id' => '1', 'id' => '1', 'name' => 'red', }, { 'description' => { 'id' => '3', 'text' => 'desc 3' }, 'description_id' => '3', 'id' => '3', 'name' => 'green', } ], 'id' => '2', 'name' => 'Sled', 'sale_date' => '2005-02-02 00:00:00', 'vendor' => { 'id' => '2', 'name' => 'V2', 'region' => { 'id' => 'US', 'name' => 'America' }, 'region_id' => 'US', 'vendor' => { 'id' => '1', 'name' => 'V1', 'region_id' => 'DE', 'vendor_id' => undef }, 'vendor_id' => '1', 'vendors' => [] }, 'vendor_id' => '2' }; is_deeply($tree, $check_tree, "as_tree force, depth 2, allow_loops => 1, /^p/ - $db_type"); $new_from_tree = $product_class->new_from_tree($tree); is_deeply($new_from_tree->as_tree(allow_loops => 1, prune => sub { shift->name =~ /^p/ }), $check_tree, "new_from_tree 5 - $db_type"); if($Have_JSON) { my $json = $product_class->new(id => 2)->as_json(force_load => 1, max_depth => 2, allow_loops => 1); my $new_from_json = $product_class->new_from_json($json); is_deeply($check_tree, $new_from_json->as_tree(allow_loops => 1, prune => sub { shift->name =~ /^p/ }), "new_from_json 5 - $db_type"); } else { SKIP: { skip('JSON tests', 1) } } if($Have_YAML) { my $yaml = $product_class->new(id => 2)->as_yaml(force_load => 1, max_depth => 2, allow_loops => 1); my $new_from_yaml = $product_class->new_from_yaml($yaml); is_deeply($check_tree, $new_from_yaml->as_tree(allow_loops => 1, prune => sub { shift->name =~ /^p/ }), "new_from_yaml 5 - $db_type"); } else { SKIP: { skip('YAML tests', 1) } } $tree = $product_class->new(id => 2)->as_tree(force_load => 1, max_depth => 2, allow_loops => 1, prune => sub { shift->name =~ /^p/ }, exclude => sub { no warnings; shift->id > 2 }); $check_tree = { 'colors' => [ { 'description' => { 'id' => '1', 'text' => 'desc 1' }, 'description_id' => '1', 'id' => '1', 'name' => 'red', }, ], 'id' => '2', 'name' => 'Sled', 'sale_date' => '2005-02-02 00:00:00', 'vendor' => { 'id' => '2', 'name' => 'V2', 'region' => { 'id' => 'US', 'name' => 'America' }, 'region_id' => 'US', 'vendor' => { 'id' => '1', 'name' => 'V1', 'region_id' => 'DE', 'vendor_id' => undef }, 'vendor_id' => '1', 'vendors' => [] }, 'vendor_id' => '2' }; is_deeply($tree, $check_tree, "as_tree force, depth 2, allow_loops => 1, /^p/,id > 2 - $db_type"); $new_from_tree = $product_class->new_from_tree($tree); is_deeply($new_from_tree->as_tree(allow_loops => 1, prune => sub { shift->name =~ /^p/ }, exclude => sub { no warnings; shift->id > 2 }), $check_tree, "new_from_tree 6 - $db_type"); if($Have_JSON) { my $json = $product_class->new(id => 2)->as_json(force_load => 1, max_depth => 2, allow_loops => 1); my $new_from_json = $product_class->new_from_json($json); is_deeply($check_tree, $new_from_json->as_tree(allow_loops => 1, prune => sub { shift->name =~ /^p/ }, exclude => sub { no warnings; shift->id > 2 }), "new_from_json 6 - $db_type"); } else { SKIP: { skip('JSON tests', 1) } } if($Have_YAML) { my $yaml = $product_class->new(id => 2)->as_yaml(force_load => 1, max_depth => 2, allow_loops => 1); my $new_from_yaml = $product_class->new_from_yaml($yaml); is_deeply($check_tree, $new_from_yaml->as_tree(allow_loops => 1, prune => sub { shift->name =~ /^p/ }, exclude => sub { no warnings; shift->id > 2 }), "new_from_yaml 6 - $db_type"); } else { SKIP: { skip('YAML tests', 1) } } # Test round-trip of non-column attributes $product_class->meta->add_nonpersistent_column( other_date => { type => 'datetime', default => DateTime->new(year => 2008, month => 12, day => 31) }); $product_class->meta->make_nonpersistent_column_methods; my $p3 = $product_class->new( id => 3, name => 'Barn', other_date => '12/31/2007'); $check_tree = { 'id' => 3, 'name' => 'Barn', 'other_date' => '2007-12-31 00:00:00', 'sale_date' => undef, 'vendor_id' => undef }; is_deeply($p3->as_tree, $check_tree, "nonpersistent columns 1 - $db_type"); $check_tree = { 'id' => 3, 'name' => 'Barn', 'sale_date' => undef, 'vendor_id' => undef }; is_deeply($p3->as_tree(persistent_columns_only => 1), $check_tree, "nonpersistent columns 2 - $db_type"); #$tree = $p3->as_tree # my $p3 = # $product_class->new( # id => 3, # name => 'Barn', # vendor => { id => 3, name => 'V3', region => { id => 'UK', name => 'England' }, vendor_id => 2 }, # prices => [ { price => 100 } ], # colors => # [ # { name => 'green' }, # { # name => 'pink', # description => # { # text => 'desc 4', # authors => [ { name => 'joe', nicknames => [ { nick => 'joey' } ] } ], # } # } # ]); # # $p3->save; #local $Rose::DB::Object::Manager::Debug = 1; } # # init_with_tree() bug # INIT_WITH_TREE_BUG: { SKIP: { skip("init_with_tree() bug tests", 4) unless(%Have); } next unless(%Have); package Project::Model::User; use base qw(Rose::DB::Object); __PACKAGE__->meta->setup ( table => 'user', columns => [ id => { type => 'bigserial', not_null => 1 }, name => { type => 'varchar', length => 100, not_null => 1 }, password => { type => 'varchar', length => 100, not_null => 1 }, name_prefix => { type => 'varchar', length => 20 }, first_name => { type => 'varchar', length => 255 }, last_name => { type => 'varchar', length => 255 }, reseller_id => { type => 'integer', default => 0, not_null => 1 }, created_at => { type => 'datetime', not_null => 1 }, updated_at => { type => 'datetime', not_null => 1 }, parent_user_id => { type => 'bigint' }, user_company_id => { type => 'bigint' }, company_name => { type => 'varchar', length => 255 }, owner_user_id => { type => 'bigint' }, user_title_id => { type => 'bigint' }, job_title => { type => 'varchar', length => 255 }, primary_user_company_id => { type => 'bigint' }, primary_user_title_id => { type => 'bigint' }, primary_user_phone_id => { type => 'bigint' }, primary_user_email_id => { type => 'bigint' }, primary_user_address_id => { type => 'bigint' }, commission_user_address_id => { type => 'bigint' }, user_source_id => { type => 'integer' }, updated_by_user_id => { type => 'bigint' }, locale_id => { type => 'integer', not_null => 1 }, spoken_lang => { type => 'enum', check_in => [ 'English', 'Mandarin', 'Cantonese' ], default => 'English', not_null => 1 }, encryption_key => { type => 'character', length => 32 }, timezone_id => { type => 'integer', default => 513, not_null => 1 }, user_type_id => { type => 'integer', default => 0, not_null => 1 }, primary_billing_method_id => { type => 'bigint' }, autodetect_timezone => { type => 'integer', default => 0, not_null => 1 }, is_login_disabled => { type => 'integer', default => 0 }, security_question_id => { type => 'integer', default => 1, not_null => 1 }, security_question_custom => { type => 'varchar', length => 255 }, security_answer => { type => 'varchar', length => 255 }, has_temporary_password => { type => 'integer', default => 0 }, email_id => { type => 'bigint' }, payment_failure_status => { type => 'integer', default => 0, not_null => 1 }, notes => { type => 'text', length => 65535 }, ], primary_key_columns => ['id'], unique_keys => [['email_id'], ['name'],], relationships => [ user_addresses => { class => 'Project::Model::UserAddress', column_map => { id => 'user_id' }, type => 'one to many', }, user_emails => { class => 'Project::Model::UserEmail', column_map => { id => 'user_id' }, type => 'one to many', }, user_phones => { class => 'Project::Model::UserPhone', column_map => { id => 'user_id' }, type => 'one to many', }, ], ); package Project::Model::UserAddress; use base qw(Rose::DB::Object); __PACKAGE__->meta->setup ( table => 'user_address', columns => [ id => { type => 'bigserial', not_null => 1 }, user_id => { type => 'bigint', not_null => 1 }, user_address_type_id => { type => 'integer', not_null => 1 }, geo_country_id => { type => 'integer', not_null => 1 }, address1 => { type => 'varchar', length => 255 }, address2 => { type => 'varchar', length => 255 }, address3 => { type => 'varchar', length => 255 }, geo_subregion => { type => 'varchar', length => 255 }, geo_region_id => { type => 'integer' }, postal_code1 => { type => 'varchar', length => 5 }, postal_code2 => { type => 'varchar', length => 5 }, created_at => { type => 'datetime', not_null => 1 }, updated_at => { type => 'datetime', not_null => 1 }, ], primary_key_columns => [ 'id' ], relationships => [ users => { class => 'IV::Model::User', column_map => { id => 'commission_user_address_id' }, type => 'one to many', }, ], ); package Project::Model::UserEmail; use base qw(Rose::DB::Object); __PACKAGE__->meta->setup ( table => 'user_email', columns => [ id => { type => 'bigserial', not_null => 1 }, email => { type => 'varchar', length => 255, not_null => 1 }, user_id => { type => 'bigint', not_null => 1 }, user_email_type_id => { type => 'integer', not_null => 1 }, created_at => { type => 'datetime', not_null => 1 }, updated_at => { type => 'datetime', not_null => 1 }, ], primary_key_columns => [ 'id' ], unique_key => [ 'user_id', 'email' ], foreign_keys => [ user => { class => 'Project::Model::User', key_columns => { user_id => 'id' }, }, ], ); package Project::Model::UserPhone; use base qw(Rose::DB::Object); __PACKAGE__->meta->setup ( table => 'user_phone', columns => [ id => { type => 'bigserial', not_null => 1 }, user_id => { type => 'bigint', not_null => 1 }, geo_country_id => { type => 'integer', not_null => 1 }, area_code => { type => 'varchar', length => 4 }, number1 => { type => 'varchar', length => 10 }, number2 => { type => 'varchar', length => 10 }, extension => { type => 'varchar', length => 50 }, user_phone_type_id => { type => 'integer', not_null => 1 }, created_at => { type => 'datetime', not_null => 1 }, updated_at => { type => 'datetime', not_null => 1 }, ], primary_key_columns => ['id'], foreign_keys => [ user => { class => 'Project::Model::User', key_columns => { user_id => 'id' }, }, ], ); package main; use Rose::DB::Object::Helpers qw/as_tree init_with_tree/; my $tree = { 'user_titles' => [], 'billing_invoices' => [], 'incident_external_departments' => [], 'salescalendar_user_calendars' => [], 'salescalendar_appointment_notes' => [], 'password' => '$1$068F9leP$8jfRI43HMUS2/jxUsQTme.', 'incident_internal_departments' => [], 'user_title_id' => undef, 'reseller_id' => '4', 'incidents_external_owned_by' => [], 'primary_billing_method_id' => undef, 'name' => 'sego03', 'timezone_id' => '513', 'user_login_logs' => [], 'primary_user_email_id' => '8061', 'updated_at' => '2008-08-27 22:39:40', 'encryption_key' => '37dcd1d8fc4555fd46f063fbb8e4f55b', 'security_answer' => undef, 'commission_user_address_id' => undef, 'job_title' => '', 'updated_by_user_id' => undef, 'salescalendar_appointments' => [], 'notes_entered_by' => [], 'created_at' => '2008-07-10 00:31:58', 'owner_user_id' => '5343', 'billing_methods' => [], 'autodetect_timezone' => 0, 'domains' => [], 'notes' => undef, 'user_company_id' => undef, 'user_source_id' => '1', 'website' => {}, 'primary_user_company_id' => undef, 'company_name' => 'myCompany', 'user_phones' => [ { 'area_code' => '888', 'extension' => '', 'created_at' => '2008-07-10 00:31:58', 'number1' => '8888', 'geo_country_id' => '4', 'user_phone_type_id' => '1', 'number2' => '8888', 'id' => '8399', 'user_id' => '11647' } ], 'primary_user_address_id' => undef, 'salescalendar_appointments_cancelled_by' => [], 'user_type_id' => '6', 'id' => '11647', 'password_confirm' => '$1$068F9leP$8jfRI43HMUS2/jxUsQTme.', 'salescalendar_appointments_salesrep' => [], 'roles' => [], 'user_emails' => [ { 'email' => 'test@test.com', 'created_at' => '2008-07-10 00:31:58', 'user_email_type_id' => '1', 'id' => '8061', 'user_id' => '11647' } ], 'salescalendar_lockouts' => [], 'name_prefix' => '', 'user_companies' => [], 'payment_failure_status' => 0, 'locale_id' => '8', 'parent_user_id' => 1, 'has_temporary_password' => 0, 'email_id' => undef, 'incidents_entered_by' => [], 'contact_website' => {}, 'last_name' => 'sego03', 'is_login_disabled' => 0, 'security_question_id' => '1', 'billing_schedules' => [], 'primary_user_title_id' => undef, 'updated_users' => [], 'primary_user_phone_id' => '8399', 'spoken_lang' => 'English', 'incidents' => [], 'security_question_custom' => undef, 'incidents_internal_owned_by' => [], 'user_addresses' => [], 'child_users' => [], 'first_name' => '' }; my $user_archive = init_with_tree(Project::Model::User->new, $tree); is($user_archive->id, 11647, 'init_with_tree() columns first bug 1'); is($user_archive->user_emails->[0]->user_id, 11647, 'init_with_tree() columns first bug 2'); is($user_archive->user_phones->[0]->user_id, 11647, 'init_with_tree() columns first bug 3'); $tree = as_tree($user_archive); is($tree->{'user_phones'}[0]{'user_id'}, 11647, 'as_tree() traverse fks'); } BEGIN { our($Have_YAML, $Have_JSON); eval { require YAML::Syck }; $Have_YAML = $@ ? 0 : 1; eval { require JSON; die "JSON $JSON::VERSION too old" unless($JSON::VERSION >= 2.00); }; $Have_JSON = $@ ? 0 : 1; } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; #die "This test chokes DBD::Pg version 2.1.x and 2.2.0" if($DBD::Pg::VERSION =~ /^2\.(?:1\.|2\.0)/); }; if(!$@ && $dbh && $DBD::Pg::VERSION ge '2.15.1') { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE description_author_map CASCADE'); $dbh->do('DROP TABLE nicknames CASCADE'); $dbh->do('DROP TABLE authors CASCADE'); $dbh->do('DROP TABLE descriptions CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE regions CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.product_color_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.description_author_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.nicknames CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.authors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.descriptions CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.regions CASCADE'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); } $dbh->do(<<"EOF"); CREATE TABLE regions ( id CHAR(2) NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, vendor_id INT REFERENCES vendors (id), region_id CHAR(2) REFERENCES regions (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, vendor_id INT REFERENCES vendors (id), sale_date TIMESTAMP, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region_id CHAR(2) NOT NULL REFERENCES regions (id) DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE descriptions ( id SERIAL NOT NULL PRIMARY KEY, text VARCHAR(255) NOT NULL, UNIQUE(text) ) EOF $dbh->do(<<"EOF"); CREATE TABLE authors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE nicknames ( id SERIAL NOT NULL PRIMARY KEY, nick VARCHAR(255) NOT NULL, author_id INT REFERENCES authors (id), UNIQUE(nick, author_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE description_author_map ( description_id INT NOT NULL REFERENCES descriptions (id), author_id INT NOT NULL REFERENCES authors (id), PRIMARY KEY(description_id, author_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, description_id INT REFERENCES descriptions (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.regions ( id CHAR(2) NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, vendor_id INT REFERENCES Rose_db_object_private.vendors (id), region_id CHAR(2) REFERENCES Rose_db_object_private.regions (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, vendor_id INT REFERENCES Rose_db_object_private.vendors (id), sale_date TIMESTAMP, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES Rose_db_object_private.products (id), region_id CHAR(2) NOT NULL REFERENCES Rose_db_object_private.regions (id) DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.descriptions ( id SERIAL NOT NULL PRIMARY KEY, text VARCHAR(255) NOT NULL, UNIQUE(text) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.authors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.nicknames ( id SERIAL NOT NULL PRIMARY KEY, nick VARCHAR(255) NOT NULL, author_id INT REFERENCES Rose_db_object_private.authors (id), UNIQUE(nick, author_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.description_author_map ( description_id INT NOT NULL REFERENCES Rose_db_object_private.descriptions (id), author_id INT NOT NULL REFERENCES Rose_db_object_private.authors (id), PRIMARY KEY(description_id, author_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, description_id INT REFERENCES Rose_db_object_private.descriptions (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.product_color_map ( product_id INT NOT NULL REFERENCES Rose_db_object_private.products (id), color_id INT NOT NULL REFERENCES Rose_db_object_private.colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; die "MySQL version too old" unless($db->database_version >= 4_000_000); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE descriptions CASCADE'); $dbh->do('DROP TABLE authors CASCADE'); $dbh->do('DROP TABLE nicknames CASCADE'); $dbh->do('DROP TABLE description_author_map CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE regions CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE regions ( id CHAR(2) NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF # MySQL will silently ignore the "ENGINE=InnoDB" part and create # a MyISAM table instead. MySQL is evil! Now we have to manually # check to make sure an InnoDB table was really created. my $db_name = $db->database; my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?"); $sth->execute('regions'); my $info = $sth->fetchrow_hashref; no warnings 'uninitialized'; unless(lc $info->{'Type'} eq 'innodb' || lc $info->{'Engine'} eq 'innodb') { die "Missing InnoDB support"; } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, vendor_id INT, region_id CHAR(2), INDEX(vendor_id), INDEX(region_id), FOREIGN KEY (vendor_id) REFERENCES vendors (id), FOREIGN KEY (region_id) REFERENCES regions (id), UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, vendor_id INT, sale_date DATETIME, INDEX(vendor_id), FOREIGN KEY (vendor_id) REFERENCES vendors (id), UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INT AUTO_INCREMENT PRIMARY KEY, product_id INT, region_id CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, INDEX(product_id), INDEX(region_id), FOREIGN KEY (product_id) REFERENCES products (id), FOREIGN KEY (region_id) REFERENCES regions (id), UNIQUE(product_id, region_id) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE descriptions ( id INT AUTO_INCREMENT PRIMARY KEY, text VARCHAR(255) NOT NULL, UNIQUE(text) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE authors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE nicknames ( id INT AUTO_INCREMENT PRIMARY KEY, nick VARCHAR(255) NOT NULL, author_id INT, INDEX(author_id), FOREIGN KEY (author_id) REFERENCES authors (id), UNIQUE(nick, author_id) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE description_author_map ( description_id INT NOT NULL, author_id INT NOT NULL, INDEX(description_id), INDEX(author_id), FOREIGN KEY (description_id) REFERENCES descriptions (id), FOREIGN KEY (author_id) REFERENCES authors (id), PRIMARY KEY(description_id, author_id) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, description_id INT, INDEX(description_id), FOREIGN KEY (description_id) REFERENCES descriptions (id), UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL, color_id INT NOT NULL, INDEX(product_id), INDEX(color_id), FOREIGN KEY (product_id) REFERENCES products (id), FOREIGN KEY (color_id) REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) ENGINE=InnoDB EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE description_author_map CASCADE'); $dbh->do('DROP TABLE nicknames CASCADE'); $dbh->do('DROP TABLE authors CASCADE'); $dbh->do('DROP TABLE descriptions CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE regions CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE regions ( id CHAR(2) NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, vendor_id INT REFERENCES vendors (id), region_id CHAR(2) REFERENCES regions (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, vendor_id INT REFERENCES vendors (id), sale_date DATETIME YEAR TO SECOND, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region_id CHAR(2) DEFAULT 'US' NOT NULL REFERENCES regions (id), price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE descriptions ( id SERIAL NOT NULL PRIMARY KEY, text VARCHAR(255) NOT NULL, UNIQUE(text) ) EOF $dbh->do(<<"EOF"); CREATE TABLE authors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE nicknames ( id SERIAL NOT NULL PRIMARY KEY, nick VARCHAR(255) NOT NULL, author_id INT REFERENCES authors (id), UNIQUE(nick, author_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE description_author_map ( description_id INT NOT NULL REFERENCES descriptions (id), author_id INT NOT NULL REFERENCES authors (id), PRIMARY KEY(description_id, author_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, description_id INT REFERENCES descriptions (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE descriptions'); $dbh->do('DROP TABLE authors'); $dbh->do('DROP TABLE nicknames'); $dbh->do('DROP TABLE description_author_map'); $dbh->do('DROP TABLE product_color_map'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); $dbh->do('DROP TABLE regions'); } $dbh->do(<<"EOF"); CREATE TABLE regions ( id CHAR(2) NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, vendor_id INT REFERENCES vendors (id), region_id CHAR(2) REFERENCES regions (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, vendor_id INT REFERENCES vendors (id), sale_date DATETIME, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INTEGER PRIMARY KEY AUTOINCREMENT, product_id INT NOT NULL REFERENCES products (id), region_id CHAR(2) NOT NULL REFERENCES regions (id) DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE descriptions ( id INTEGER PRIMARY KEY AUTOINCREMENT, text VARCHAR(255) NOT NULL, UNIQUE(text) ) EOF $dbh->do(<<"EOF"); CREATE TABLE authors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE nicknames ( id INTEGER PRIMARY KEY AUTOINCREMENT, nick VARCHAR(255) NOT NULL, author_id INT REFERENCES authors (id), UNIQUE(nick, author_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE description_author_map ( description_id INT NOT NULL REFERENCES descriptions (id), author_id INT NOT NULL REFERENCES authors (id), PRIMARY KEY(description_id, author_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, description_id INT REFERENCES descriptions (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } } END { if($Have{'pg'}) { my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE description_author_map CASCADE'); $dbh->do('DROP TABLE nicknames CASCADE'); $dbh->do('DROP TABLE authors CASCADE'); $dbh->do('DROP TABLE descriptions CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE regions CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.product_color_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.description_author_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.nicknames CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.authors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.descriptions CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.regions CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->disconnect; } if($Have{'mysql'}) { my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE description_author_map CASCADE'); $dbh->do('DROP TABLE nicknames CASCADE'); $dbh->do('DROP TABLE authors CASCADE'); $dbh->do('DROP TABLE descriptions CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE regions CASCADE'); $dbh->disconnect; } if($Have{'informix'}) { my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE description_author_map CASCADE'); $dbh->do('DROP TABLE nicknames CASCADE'); $dbh->do('DROP TABLE authors CASCADE'); $dbh->do('DROP TABLE descriptions CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE regions CASCADE'); $dbh->disconnect; } if($Have{'sqlite'}) { my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE descriptions'); $dbh->do('DROP TABLE authors'); $dbh->do('DROP TABLE nicknames'); $dbh->do('DROP TABLE description_author_map'); $dbh->do('DROP TABLE product_color_map'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); $dbh->do('DROP TABLE regions'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/auto-setup.t000755 000765 000120 00000012306 11653604702 016753 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 1 + (3 * 4); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Loader'); } our %Have; # # Tests # #$Rose::DB::Object::Manager::Debug = 1; foreach my $db_type (qw(mysql pg informix sqlite)) { SKIP: { skip("$db_type tests", 3) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB::Object::Metadata->unregister_all_classes; Rose::DB->default_type($db_type); my $class_prefix = ucfirst($db_type); my $foo_class = $class_prefix . '::Foo'; my $bar_class = $class_prefix . '::Bar'; my $auto = (rand() >= 0.5) ? 'auto_initialize => [],' : 'auto => 1,'; my $perl=<<"EOF"; { package $foo_class; use base qw(Rose::DB::Object); __PACKAGE__->meta->setup ( table => 'foos', $auto ); package $bar_class; use base qw(Rose::DB::Object); __PACKAGE__->meta->setup ( table => 'bars', $auto ); } EOF eval $perl or warn $@; is($foo_class->meta->relationship('bar')->type, 'one to one', "check rel type - $db_type"); my $bar = $bar_class->new; my $foo = $foo_class->new(foo => 'xyz'); #$Rose::DB::Object::Debug = 1; $foo->bar($bar); $foo->bar->bar('some text'); $foo->save; my $check_foo = $foo_class->new(id => $foo->id)->load; my $check_bar = $bar_class->new(foo_id => $bar->foo_id)->load; is($check_foo->foo, 'xyz', "check foo - $db_type"); is($check_bar->bar, 'some text', "check bar - $db_type"); } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE bars CASCADE'); $dbh->do('DROP TABLE foos CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE foos ( id SERIAL NOT NULL PRIMARY KEY, foo VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE bars ( foo_id INT NOT NULL PRIMARY KEY REFERENCES foos (id), bar VARCHAR(255) ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; die "No innodb support" unless(mysql_supports_innodb()); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE bars CASCADE'); $dbh->do('DROP TABLE foos CASCADE'); } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE foos ( id INT AUTO_INCREMENT PRIMARY KEY, foo VARCHAR(255) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE bars ( foo_id INT PRIMARY KEY, bar VARCHAR(255), INDEX(foo_id), FOREIGN KEY (foo_id) REFERENCES foos (id) ) ENGINE=InnoDB EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE bars CASCADE'); $dbh->do('DROP TABLE foos CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE foos ( id SERIAL NOT NULL PRIMARY KEY, foo VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE bars ( foo_id INT NOT NULL PRIMARY KEY REFERENCES foos (id), bar VARCHAR(255) ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE bars'); $dbh->do('DROP TABLE foos'); } $dbh->do(<<"EOF"); CREATE TABLE foos ( id INTEGER PRIMARY KEY AUTOINCREMENT, foo VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE bars ( foo_id INTEGER PRIMARY KEY AUTOINCREMENT REFERENCES foos (id), bar VARCHAR(255) ) EOF $dbh->disconnect; } } END { # Delete test table if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE bars CASCADE'); $dbh->do('DROP TABLE foos CASCADE'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE bars CASCADE'); $dbh->do('DROP TABLE foos CASCADE'); $dbh->disconnect; } if($Have{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE bars CASCADE'); $dbh->do('DROP TABLE foos CASCADE'); $dbh->disconnect; } if($Have{'sqlite'}) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE bars'); $dbh->do('DROP TABLE foos'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/benchmarks/000750 000765 000120 00000000000 12266514755 016574 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/bind-param.t000755 000765 000120 00000014157 11225465612 016665 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 1 + (2 * 13); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Loader'); } our %Have; # # Tests # #$Rose::DB::Object::Manager::Debug = 1; foreach my $db_type (qw(pg mysql)) { SKIP: { skip("$db_type tests", 13) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB->default_type($db_type); my $class_prefix = ucfirst($db_type); my $loader = Rose::DB::Object::Loader->new( db => Rose::DB->new, class_prefix => $class_prefix); my @classes = $loader->make_classes(include_tables => '^rose_db_object_test$'); my $object_class = $class_prefix . '::RoseDbObjectTest'; my $manager_class = $object_class . '::Manager'; my $data = "\000\001\002\003\004\005" x 10; # Standard save my $o = $object_class->new(num => 123, data => $data); $o->save; $o = $object_class->new(id => $o->id)->load; is($o->data, $data, "save 1 - $db_type"); $o->save; $o = $object_class->new(id => $o->id)->load; is($o->data, $data, "save 2 - $db_type"); # Changes only my $short_data = "\000\001\002\003\004\005"; $o->data($short_data); $o->save(changes_only => 1); $o = $object_class->new(id => $o->id)->load; is($o->data, $short_data, "update changes only - $db_type"); $o = $object_class->new(data => $short_data); $o->save(changes_only => 1); $o = $object_class->new(id => $o->id)->load; is($o->data, $short_data, "insert changes only - $db_type"); # On duplicate key update if($o->db->supports_on_duplicate_key_update) { # Force the bind_param code to be triggered (should be harmless) local $object_class->meta->{'dbi_requires_bind_param'}{$o->db->{'id'}} = 1; my $data = "\000\001\002"; $o->data($data); $o->insert(on_duplicate_key_update => 1); $o = $object_class->new(id => $o->id)->load; is($o->data, $data, "on duplicate key update - $db_type"); } else { ok(1, "on duplicate key update not supported - $db_type"); } # # Allow inline column values # $object_class->meta->allow_inline_column_values(1); $manager_class->delete_rose_db_object_test(all => 1); $data = "\000\001\002\003\004\005" x 10; # Standard save $o = $object_class->new(num => 123, data => $data); $o->save; $o = $object_class->new(id => $o->id)->load; is($o->data, $data, "inline - save 1 - $db_type"); $o->save; $o = $object_class->new(id => $o->id)->load; is($o->data, $data, "inline - save 2 - $db_type"); # Changes only $short_data = "\000\001\002\003\004\005"; $o->data($short_data); $o->save(changes_only => 1); $o = $object_class->new(id => $o->id)->load; is($o->data, $short_data, "inline - update changes only - $db_type"); $o = $object_class->new(data => $short_data); $o->save(changes_only => 1); $o = $object_class->new(id => $o->id)->load; is($o->data, $short_data, "inline - insert changes only - $db_type"); # On duplicate key update if($o->db->supports_on_duplicate_key_update) { # Force the bind_param code to be triggered (should be harmless) local $object_class->meta->{'dbi_requires_bind_param'}{$o->db->{'id'}} = 1; my $data = "\000\001\002"; $o->data($data); $o->insert(on_duplicate_key_update => 1); $o = $object_class->new(id => $o->id)->load; is($o->data, $data, "inline - on duplicate key update - $db_type"); } else { ok(1, "inline - on duplicate key update not supported - $db_type"); } # # Manager # my $os = $manager_class->get_rose_db_object_test( query => [ data => $o->data, id => $o->id ]); ok($os && @$os == 1 && $os->[0]->id == $o->id, "manager 1 - $db_type"); $os = $manager_class->get_rose_db_object_test( query => [ data => [ "\000\001", $o->data ], or => [ data => [ "\000\002", $o->data ], id => { ne => [ 123, 456 ] }, ], id => $o->id ]); ok($os && @$os == 1 && $os->[0]->id == $o->id, "manager 2 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; $os = $manager_class->get_rose_db_object_test( query => [ data => [ "\000\001", $o->data ], num => undef, or => [ data => [ "\000\002", $o->data ], id => { ne => [ 123, 456 ] }, or => [ data => [ "\001\003", $o->data ], data => { ne => "\000" }, id => { ne => undef }, num => undef, '!data' => "\002\003", data => $o->data, ] ], id => $o->id ]); ok($os && @$os == 1 && $os->[0]->id == $o->id, "manager 3 - $db_type"); } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id SERIAL PRIMARY KEY, num INT, data BYTEA ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT AUTO_INCREMENT PRIMARY KEY, num INT, data BLOB ) EOF } } END { # Delete test table if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/column-triggers.t000755 000765 000120 00000041404 12054157213 017763 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 284; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Manager'); use_ok('Rose::DateTime::Util'); } use Rose::DateTime::Util qw(parse_date); our(%Have, $Did_Setup, %Temp); # # Setup # SETUP: { package MyObject; our @ISA = qw(Rose::DB::Object); MyObject->meta->table('Rose_db_object_test'); MyObject->meta->columns ( id => { primary_key => 1, not_null => 1 }, name => { type => 'varchar', length => 32, on_set => sub { die "foo" }, on_get => [ sub { die "bar" }, sub { die "baz" } ] }, code => { type => 'varchar', length => 32 }, start => { type => 'date', default => '12/24/1980' }, ended => { type => 'scalar', default => '11/22/2003' }, date_created => { type => 'timestamp' }, ); foreach my $column (MyObject->meta->columns) { $column->add_auto_method_types(qw(get set)); $column->method_name('get' => 'xget_' . $column->name); $column->method_name('set' => 'xset_' . $column->name); } my $column = MyObject->meta->column('name'); foreach my $event (qw(on_set on_get on_load on_save inflate deflate)) { $column->add_trigger($event => sub { die "foo" }) unless($event eq 'on_set'); unless($event eq 'on_get') { $column->add_trigger($event => sub { die "bar" }); $column->add_trigger($event => sub { die "baz" }); } } $column->delete_triggers('on_set'); Test::More::ok(!defined $column->triggers('on_set'), 'delete_triggers 1'); Test::More::ok(defined $column->triggers('on_get'), 'delete_triggers 2'); $column->delete_triggers; my $i = 2; foreach my $event (qw(on_set on_get on_load on_save inflate deflate)) { $i++; Test::More::ok(!defined $column->triggers($event), "delete_triggers $i"); } # 0: die $column->add_trigger(event => 'on_get', name => 'die', code => sub { die "blah" }); # 1: die, dyn $column->add_trigger(event => 'on_get', code => sub { $Temp{'get'}{'name'} = shift->name }); # XXX: This relies on knowledge of how generate_trigger_name() works my $dyn_name = "dyntrig_${$}_19"; # 0: warn, die, dyn $column->add_trigger(event => 'on_get', name => 'warn', code => sub { warn "boo" }, position => 'first'); Test::More::is($column->trigger_index('on_get', 'warn'), 0, 'trigger_index 1'); Test::More::is($column->trigger_index('on_get', 'die'), 1, 'trigger_index 2'); Test::More::is($column->trigger_index('on_get', $dyn_name), 2, 'trigger_index 3'); $column->delete_trigger(event => 'on_get', name => 'die'); Test::More::is($column->trigger_index('on_get', 'warn'), 0, 'trigger_index 4'); Test::More::is($column->trigger_index('on_get', $dyn_name), 1, 'trigger_index 5'); $column->delete_trigger(event => 'on_get', name => 'warn'); Test::More::is($column->trigger_index('on_get', $dyn_name), 0, 'trigger_index 6'); my $indexes = $column->trigger_indexes('on_get'); Test::More::is(keys %$indexes, 1, 'trigger_indexes 1'); my $triggers = $column->triggers('on_get'); Test::More::is(scalar @$triggers, 1, 'triggers 1'); $column->add_trigger(event => 'on_set', code => sub { $Temp{'set'}{'name'} = shift->name }); $column->add_trigger(on_load => sub { $Temp{'on_load'}{'name'} = shift->name }); $column->add_trigger(on_save => sub { $Temp{'on_save'}{'name'} = shift->name }); $column->add_trigger(inflate => sub {no warnings 'uninitialized'; $Temp{'inflate'}{'name'} = shift->name }); $column->add_trigger(deflate => sub { no warnings 'uninitialized'; $Temp{'deflate'}{'name'} = uc $_[1] }); $column = MyObject->meta->column('code'); $column->add_trigger(inflate => sub { no warnings 'uninitialized'; lc $_[1] }); $column->add_trigger(deflate => sub { no warnings 'uninitialized'; uc $_[1] }); $column = MyObject->meta->column('start'); $column->add_trigger(inflate => sub { ref $_[1] ? $_[1]->add(days => 1) : $_[1] }); $column->add_trigger(deflate => sub { if(ref $_[1]) { $_[1]->subtract(days => 1); return $_[0]->db->format_date($_[1]); } return $_[1]; }); $column->add_trigger(on_set => sub { shift->name('start set') }); $column->add_trigger(on_get => sub { shift->name('start get') }); $column = MyObject->meta->column('ended'); $column->add_trigger(inflate => sub { # Handle older MySQL version of timestamp values if(defined $_[1]) { $_[1] =~ s/^(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/$1-$2-$3 $2:$5:$6/; } defined $_[1] ? (Rose::DateTime::Util::parse_date($_[1]) || $_[0]->db->parse_date($_[1])) : undef }); $column->add_trigger(deflate => sub { defined $_[1] ? $_[0]->db->format_date(Rose::DateTime::Util::parse_date($_[1]) || $_[0]->db->parse_date($_[1])) : undef }); # Test built-in triggers # 0: die $column->add_builtin_trigger(event => 'on_get', name => 'die', code => sub { die "blah" }); # 1: die, dyn $column->add_builtin_trigger(event => 'on_get', code => sub { $Temp{'bi'}{'get'}{'name'} = shift->name }); # This relies on knowledge of how generate_trigger_name() works $dyn_name = "dyntrig_${$}_33"; # 0: warn, die, dyn $column->add_builtin_trigger(event => 'on_get', name => 'warn', code => sub { warn "boo" }, position => 'first'); Test::More::is($column->builtin_trigger_index('on_get', 'warn'), 0, 'builtin_trigger_index 1'); Test::More::is($column->builtin_trigger_index('on_get', 'die'), 1, 'builtin_trigger_index 2'); Test::More::is($column->builtin_trigger_index('on_get', $dyn_name), 2, 'builtin_trigger_index 3'); $column->delete_builtin_trigger(event => 'on_get', name => 'die'); Test::More::is($column->builtin_trigger_index('on_get', 'warn'), 0, 'builtin_trigger_index 4'); Test::More::is($column->builtin_trigger_index('on_get', $dyn_name), 1, 'builtin_trigger_index 5'); $column->delete_builtin_trigger(event => 'on_get', name => 'warn'); Test::More::is($column->builtin_trigger_index('on_get', $dyn_name), 0, 'builtin_trigger_index 6'); $indexes = $column->builtin_trigger_indexes('on_get'); Test::More::is(keys %$indexes, 1, 'builtin_trigger_indexes 1'); $triggers = $column->builtin_triggers('on_get'); Test::More::is(scalar @$triggers, 1, 'builtin_triggers 1'); $column->add_builtin_trigger(event => 'on_set', code => sub { $Temp{'bi'}{'set'}{'name'} = shift->name }); $column->add_builtin_trigger(on_load => sub { $Temp{'bi'}{'on_load'}{'name'} = shift->name }); $column->add_builtin_trigger(on_save => sub { $Temp{'bi'}{'on_save'}{'name'} = shift->name }); $column->add_builtin_trigger(inflate => sub { $Temp{'bi'}{'inflate'}{'name'} = shift->name }); $column->add_builtin_trigger(deflate => sub { $Temp{'bi'}{'deflate'}{'name'} = uc $_[1] }); $column->delete_builtin_triggers; $i = 0; foreach my $event (qw(on_set on_get on_load on_save inflate deflate)) { $i++; $indexes = $column->builtin_trigger_indexes($event); Test::More::is(keys %$indexes, 0, "delete_builtin_triggers $i"); $i++; $triggers = $column->builtin_triggers($event); Test::More::ok(!defined $triggers, "delete_builtin_triggers $i"); } } # # Tests # my @dbs = qw(mysql pg pg_with_schema informix sqlite); eval { require List::Util }; @dbs = List::Util::shuffle(@dbs) unless($@); #@dbs = qw(informix sqlite mysql pg_with_schema pg); foreach my $db_type (@dbs) { SKIP: { skip("$db_type tests", 49) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB->default_type($db_type); unless($Did_Setup++) { MyObject->meta->initialize; } ## ## Run tests ## %Temp = (); # # name # my $o = MyObject->new; is($o->name('Fred'), 'Fred', "on_set return 1 - $db_type"); is($Temp{'set'}{'name'}, 'Fred', "on_set 1 - $db_type"); is(keys %Temp, 1, "on_set 2 - $db_type"); %Temp = (); is($o->xset_name('Fred'), 'Fred', "on_set return 2 - $db_type"); is($Temp{'set'}{'name'}, 'Fred', "on_set 3 - $db_type"); is(keys %Temp, 1, "on_set 4 - $db_type"); %Temp = (); my $name = $o->xget_name; is($Temp{'get'}{'name'}, 'Fred', "on_get 1 - $db_type"); is($Temp{'inflate'}{'name'}, 'Fred', "on_get 2 - $db_type"); is(keys %Temp, 2, "on_get 3 - $db_type"); %Temp = (); $name = $o->name; is($Temp{'get'}{'name'}, 'Fred', "on_get 4 - $db_type"); is(keys %Temp, 1, "on_get 5 - $db_type"); %Temp = (); $name = $o->xget_name; is($Temp{'get'}{'name'}, 'Fred', "on_get 6 - $db_type"); is(keys %Temp, 1, "on_get 7 - $db_type"); %Temp = (); #local $Rose::DB::Object::Debug = 1; $o->save; is($Temp{'on_save'}{'name'}, 'FRED', "on_save 1 - $db_type"); is($Temp{'deflate'}{'name'}, 'FRED', "on_save 2 - $db_type"); is(keys %Temp, 2, "on_save 3 - $db_type"); %Temp = (); $o->load; is($Temp{'on_load'}{'name'}, 'FRED', "on_load 1 - $db_type"); is(keys %Temp, 1, "on_load 2 - $db_type"); %Temp = (); is($o->name, 'FRED', "deflate 1 - $db_type"); is($Temp{'get'}{'name'}, 'FRED', "on_get 8 - $db_type"); is($Temp{'inflate'}{'name'}, 'FRED', "on_get 9 - $db_type"); is(keys %Temp, 2, "on_get 10 - $db_type"); %Temp = (); $o->name('Fred'); is($Temp{'set'}{'name'}, 'Fred', "on_set 5 - $db_type"); is(keys %Temp, 1, "on_set 6 - $db_type"); %Temp = (); MyObject->meta->column('name')->add_trigger( event => 'inflate', name => 'lc_inflate', code => sub { $Temp{'lc_inflate'}{'name'} = lc shift->name }); is($o->name, 'fred', "inflate 1 - $db_type"); is($Temp{'get'}{'name'}, 'fred', "inflate 2 - $db_type"); is($Temp{'inflate'}{'name'}, 'Fred', "inflate 3 - $db_type"); is($Temp{'lc_inflate'}{'name'}, 'fred', "inflate 4 - $db_type"); is(keys %Temp, 3, "inflate 5 - $db_type"); %Temp = (); $o = MyObject->new(); $o->meta->add_unique_keys('name'); $o->name('FRED'); $o->load(speculative => 1); isnt($Temp{'on_save'}{'name'}, 'FRED', "on_load/on_save mix - $db_type"); # # code # $o = MyObject->new(name => 'foo', code => 'Abc'); is($o->code, 'abc', "inflate/deflate 1 - $db_type"); $o->save; my $sth = $o->db->dbh->prepare( 'SELECT code FROM ' . $o->meta->fq_table_sql($o->db) . ' WHERE id = ?'); $sth->execute($o->id); my $code = $sth->fetchrow_array; $sth->finish; is($code, 'ABC', "inflate/deflate 2 - $db_type"); is($o->code, 'abc', "inflate/deflate 3 - $db_type"); is($o->xget_code, 'abc', "inflate/deflate 4 - $db_type"); # # start # $o->start('2002-10-20'); is($o->name, 'start set', "start 1 - $db_type"); $o->save; is($o->name, 'start set', "start 2 - $db_type"); $sth = $o->db->dbh->prepare( 'SELECT start FROM ' . $o->meta->fq_table_sql($o->db) . ' WHERE id = ?'); $sth->execute($o->id); my $start = $sth->fetchrow_array; $sth->finish; $start = parse_date($start); is($start->ymd, '2002-10-19', "start 3 - $db_type"); is($o->start->ymd, '2002-10-20', "start 4 - $db_type"); is($o->name, 'start get', "start 5 - $db_type"); $o->load; is($o->start->ymd, '2002-10-20', "start 6 - $db_type"); $start = $o->start(truncate => 'month'); is($start->ymd, '2002-10-01', "start 7 - $db_type"); $start = $o->start(format => '%B %E %Y'); is($start, 'October 20th 2002', "start 8 - $db_type"); # # ended # $o = MyObject->new; is($o->ended->ymd, '2003-11-22', "ended 1 - $db_type"); $o->ended('1999-09-10'); is($o->ended->ymd, '1999-09-10', "ended 2 - $db_type"); $o->save; $o = MyObject->new(id => $o->id); $o->load; is($o->ended->ymd, '1999-09-10', "ended 3 - $db_type"); $o->ended('2/3/2004'); is($o->ended->ymd, '2004-02-03', "ended 4 - $db_type"); $o->ended(DateTime->new(year => 1980, month => 5, day => 20)); is($o->ended->ymd, '1980-05-20', "ended 5 - $db_type"); $o->meta->column('ended')->disable_triggers; $o->ended('2/13/2004'); is($o->ended, '2/13/2004', "disable_triggers - $db_type"); $o->meta->column('ended')->enable_triggers; $o->ended('2/3/2003'); is($o->ended->ymd, '2003-02-03', "enable_triggers - $db_type"); # # Clean-up # MyObject->meta->column('name')->delete_trigger(event => 'inflate', name => 'lc_inflate'); } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_test CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); } $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, code VARCHAR(32), start DATE NOT NULL DEFAULT '1980-12-24', ended TIMESTAMP, date_created TIMESTAMP ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.Rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, code VARCHAR(32), start DATE NOT NULL DEFAULT '1980-12-24', ended TIMESTAMP, date_created TIMESTAMP ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_test CASCADE'); } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_test ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, name VARCHAR(32) NOT NULL, code VARCHAR(32), start DATE NOT NULL DEFAULT '1980-12-24', ended TIMESTAMP, date_created TIMESTAMP ) EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_test CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, code VARCHAR(32), start DATE DEFAULT '12/24/1980' NOT NULL, ended DATE, date_created DATETIME YEAR TO SECOND ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_test ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(32) NOT NULL, code VARCHAR(32), start DATE DEFAULT '1980-12-24' NOT NULL, ended DATE, date_created DATETIME ) EOF $dbh->disconnect; } } END { # Delete test table if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_test CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_test CASCADE'); $dbh->disconnect; } if($Have{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_test CASCADE'); $dbh->disconnect; } if($Have{'sqlite'}) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_test'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/column-values.t000644 000765 000120 00000013447 12071571554 017446 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; require Test::More; require 't/test-lib.pl'; if(have_db('sqlite_admin')) { Test::More->import(tests => 219); #Test::More->import('no_plan'); } else { Test::More->import(skip_all => 'No SQLite'); } use_ok('DateTime'); use_ok('DateTime::Duration'); use_ok('Time::Clock'); use_ok('Bit::Vector'); use_ok('Rose::DB::Object'); package My::DB::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } My::DB::Object->meta->table('rose_db_object_nonesuch'); package main; use Rose::DB::Object::Util qw(set_state_saving unset_state_saving); my $classes = My::DB::Object->meta->column_type_classes; my $meta = My::DB::Object->meta; my $DT = DateTime->new(year => 2007, month => 12, day => 31, hour => 12, minute => 34, second => 56, nanosecond => 123456789); my $Time = Time::Clock->new('12:34:56'); my $Dur = DateTime::Duration->new(years => 3); my $Set = [ 1, 2, 3 ]; my $Array = [ 4, 5, 6 ]; my $BV = Bit::Vector->new_Dec(32, 123); my %extra = ( enum => { values => [ 'foo', 'bar' ] }, bitfield => { bits => 32 }, bits => { bits => 32 }, ); my $i = 0; foreach my $type (sort keys (%$classes)) #(qw(bits))# { $i++; my %e = $extra{$type} ? %{$extra{$type}} : (); $meta->add_column("c$i" => { type => $type, %e }); } foreach my $type (qw(char varchar)) { foreach my $mode (qw(fatal warn truncate)) { $meta->add_column("overflow_${type}_$mode" => { type => $type, overflow => $mode, length => 4 }); } } $meta->initialize; my $o = My::DB::Object->new; foreach my $type (qw(char varchar)) { my $column_name = "overflow_${type}_fatal"; my $column = $o->meta->column($column_name); my $db = db_for_column_type($column->type); unless($db) { SKIP: { skip("db unavailable for $type tests", 5); } next; } $o->db($db); TRY: { local $@; eval { $column->parse_value($db, '12345') }; like($@, qr/^My::DB::Object: Value for $column_name is too long. Maximum length is 4 characters. Value is 5 characters: 12345 /, $column_name); } $column_name = "overflow_${type}_warn"; $column = $o->meta->column($column_name); WARN1: { my $warning = ''; local $SIG{'__WARN__'} = sub { $warning .= join('', @_) }; is($column->parse_value($db, '12345'), '1234', "$column_name 1"); like($warning, qr/^My::DB::Object: Value for $column_name is too long. Maximum length is 4 characters. Value is 5 characters: 12345 /, "$column_name 2"); } $column_name = "overflow_${type}_truncate"; $column = $o->meta->column($column_name); WARN2: { my $warning = ''; local $SIG{'__WARN__'} = sub { $warning .= join('', @_) }; is($column->parse_value($db, '12345'), '1234', "$column_name 1"); is($warning, '', "$column_name 2"); } } foreach my $n (1 .. $i) { my $col_name = "c$n"; my $column = $meta->column($col_name); my $type = $column->type; my $method = method_for_column_type($type, $n); my $db = db_for_column_type($column->type); unless($db) { SKIP: { skip("db unavailable for $type tests", 2); } next; } $o->db($db); my $vn = 0; foreach my $input_value (input_values_for_column_type($type)) { $o->$method($input_value); my $parsed_value = $o->$method(); set_state_saving($o); my $formatted_value = $o->$method(); unset_state_saving($o); is(massage_value(scalar $column->parse_value($db, $input_value)), massage_value($parsed_value), "$type parse_value $n.$vn"); is(massage_value(scalar $column->format_value($db, $parsed_value)), massage_value($formatted_value), "$type format_value $n.$vn ($formatted_value)"); $vn++; } } sub massage_value { my($value) = shift; if(ref $value eq 'ARRAY') { return "@$value"; } elsif(ref $value eq 'DateTime::Duration') { return join(':', map { $value->$_() } qw(years months weeks days hours minutes seconds nanoseconds)); } return undef unless(defined $value); # XXX: Trim off leading + sign that some versions of Math::BigInt seem to add $value =~ s/^\+//; return "$value"; } my %DB; sub db_for_column_type { my($type) = shift; if($type =~ / year to |^set$/) { return $DB{'informix'} ||= Rose::DB->new('informix'); } elsif($type =~ /^(?:interval|chkpass)$/) { return $DB{'pg'} ||= Rose::DB->new('pg'); } else { return $DB{'sqlite'} ||= Rose::DB->new('sqlite'); } } sub method_for_column_type { my($type, $i) = @_; if($type eq 'chkpass') { return "c${i}_encrypted"; } return "c$i"; } sub input_values_for_column_type { my($type) = shift; if($type =~ /date|timestamp|epoch/) { return $DT, $DT->strftime('%Y-%m-%d %H:%M:%S.%N'), $DT->strftime('%m/%d/%Y %I:%M:%S.%N %p'); } elsif($type eq 'time') { return $Time, $Time->as_string; } elsif($type eq 'interval') { return '3 years'; } elsif($type eq 'enum') { return 'bar'; } elsif($type eq 'set') { return $Set, '{1,2,3}'; } elsif($type eq 'array') { return $Array, '{4,5,6}'; } elsif($type =~ /^(?:bitfield|bits)/) { return $BV, $BV->to_Bin, $BV->to_Hex, '001111011'; } elsif($type =~ /^bool/) { return 0, 'false', 'F', 1, 'true', 'T'; } elsif($type eq 'chkpass') { return ':vOR7BujbRZSLP'; } return 456; } sub value_for_column_type { my($type) = shift; if($type =~ /date|timestamp|epoch/) { return $DT; } elsif($type eq 'time') { return $Time; } elsif($type eq 'interval') { return $Dur; } elsif($type eq 'enum') { return 'bar'; } elsif($type eq 'set') { return $Set; } elsif($type eq 'array') { return $Array; } elsif($type =~ /^(?:bitfield|bits)/) { return $BV; } elsif($type =~ /^bool/) { return 0; } elsif($type eq 'chkpass') { return ':vOR7BujbRZSLP'; } return 456; } Rose-DB-Object-0.810/t/db-migration.t000755 000765 000120 00000022542 11225465612 017224 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 33; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); } our %Have; # # Tests # #$Rose::DB::Object::Manager::Debug = 1; SKIP: { skip("migration tests", 32) unless($Have{'pg'} && $Have{'mysql'}); #$DB::single = 1; #$Rose::DB::Object::Debug = 1; my $db_pg = Rose::DB->new('pg'); my $db_ws = Rose::DB->new('pg_with_schema'); my $db_my = Rose::DB->new('mysql'); my $a1 = Album->new(id => 1, db => $db_pg, name => 'One', year => 2001, dt => '1/2/2003 4:56:12')->save; my $a2 = Album->new(id => 2, db => $db_pg, name => 'Two', year => 2002, dt => '2/2/2003 4:56:12')->save; my $a3 = Album->new(id => 1, db => $db_ws, name => 'OneWS', year => 2003, dt => '3/2/2003 4:56:12')->save; my $a4 = Album->new(id => 2, db => $db_my, name => 'TwoMy', year => 2004, dt => '4/2/2003 4:56:12')->save; # pg -> pg with schema $a2->db($db_ws); $a2->delete; $a2->save; $a2 = Album->new(id => 2, db => $db_ws)->load; is($a2->name, 'Two', 'pg -> pg with schema'); # pg with schema -> pg $a3->db($db_pg); $a3->save; $a3 = Album->new(id => 1, db => $db_pg)->load; is($a3->name, 'OneWS', 'pg with schema -> pg'); $a1 = Album->new(id => 1, db => $db_pg)->load; $a2 = Album->new(id => 2, db => $db_pg)->load; $a3 = Album->new(id => 1, db => $db_ws)->load; $a4 = Album->new(id => 2, db => $db_my)->load; # pg -> mysql $a2->db($db_my); $a2->delete; $a2->save; $a2 = Album->new(id => 2, db => $db_my)->load; is($a2->name, 'Two', 'pg -> mysql'); # pg with schema -> mysql $a3->db($db_my); $a3->delete; $a3->save; $a3 = Album->new(id => 1, db => $db_my)->load; is($a3->name, 'OneWS', 'pg with schema -> mysql 1'); is($a3->dt->month, 3, 'pg with schema -> mysql 2'); $a1 = Album->new(id => 1, db => $db_pg)->load; $a2 = Album->new(id => 2, db => $db_pg)->load; $a3 = Album->new(id => 1, db => $db_ws)->load; $a4 = Album->new(id => 2, db => $db_my)->load; $a4->name('TwoMy'); $a4->save; # mysql -> pg $a4->db($db_pg); $a4->save; $a4 = Album->new(id => 2, db => $db_my)->load; is($a4->name, 'TwoMy', 'mysql -> pg'); # mysql -> pg with schema $a4 = Album->new(id => 2, db => $db_my)->load; $a4->db($db_ws); $a4->save; $a4 = Album->new(id => 2, db => $db_ws)->load; is($a4->name, 'TwoMy', 'mysql -> pg with schema'); $a1 = Album->new(id => 1, db => $db_pg)->load; $a2 = Album->new(id => 2, db => $db_pg)->load; $a3 = Album->new(id => 1, db => $db_ws)->load; $a4 = Album->new(id => 2, db => $db_my)->load; is($a1->dt->month, 3, 'dt check 1'); is($a2->dt->month, 2, 'dt check 2'); is($a3->dt->month, 3, 'dt check 2'); is($a4->dt->month, 2, 'dt check 3'); # # Test with schema override # # Rose::DB::MySQL currently supports schema as a stand-in for database. # We need to turn that off for this test because we don't control the # database(s) the test suite runs against. Rose::DB::MySQL->supports_schema(0); $a1 = AlbumWS->new(id => 10, db => $db_pg, name => 'Ten', year => 2001, dt => '1/2/2003 4:56:12')->save; $a2 = AlbumWS->new(id => 20, db => $db_pg, name => 'Twe', year => 2002, dt => '2/2/2003 4:56:12')->save; $a3 = AlbumWS->new(id => 30, db => $db_ws, name => 'Thi', year => 2003, dt => '3/2/2003 4:56:12')->save; $a4 = AlbumWS->new(id => 40, db => $db_my, name => 'For', year => 2004, dt => '4/2/2003 4:56:12')->save; $a1->db($db_my); $a1->save(insert => 1); $a1 = AlbumWS->new(id => 10, db => $db_my)->load; is($a1->name, 'Ten', 'pg forced schema -> mysql 1'); is($a1->dt->month, 1, 'pg forced schema -> mysql 2'); $a2->db($db_my); $a2->save(insert => 1); $a2 = AlbumWS->new(id => 20, db => $db_my)->load; is($a2->name, 'Twe', 'pg forced schema -> mysql 3'); is($a2->dt->month, 2, 'pg forced schema -> mysql 4'); $a3->db($db_my); $a3->save(insert => 1); $a3 = AlbumWS->new(id => 30, db => $db_my)->load; is($a3->name, 'Thi', 'pg forced schema -> mysql 5'); is($a3->dt->month, 3, 'pg forced schema -> mysql 6'); $a4->db($db_pg); $a4->save(insert => 1); $a4 = AlbumWS->new(id => 40, db => $db_ws)->load; is($a4->name, 'For', 'mysql -> pg forced schema 7'); is($a4->dt->month, 4, 'pg forced schema -> mysql 8'); # # Test multi-pk with sequences # $a1 = Code->new(name => 'One', db => $db_pg, id2 => 2)->save; $a2 = Code->new(name => 'Two', db => $db_ws, id2 => 3)->save; $a3 = Code->new(name => 'Thr', db => $db_my, id2 => 5, id3 => 6)->save; is($a1->id1, 1, 'multi-pk check pk 1'); is($a1->id2, 2, 'multi-pk check pk 2'); is($a1->id3, 1, 'multi-pk check pk 3'); is($a2->id1, 1, 'multi-pk check pk 4'); is($a2->id2, 3, 'multi-pk check pk 5'); is($a2->id3, 2, 'multi-pk check pk 6'); is($a3->id1, 1, 'multi-pk check pk 7'); is($a3->id2, 5, 'multi-pk check pk 8'); is($a3->id3, 6, 'multi-pk check pk 9'); # pg -> mysql $a1->db($db_my); $a1->delete; $a1->save; $a1 = Code->new(id1 => 1, id2 => 2, id3 => 1)->load; is($a1->name, 'One', 'multi-pk pg -> mysql'); # pg with schema -> mysql $a2->db($db_my); $a2->save(insert => 1); $a2 = Code->new(id1 => 1, id2 => 3, id3 => 2, db => $db_my)->load; is($a2->name, 'Two', 'multi-pk pg with schema -> mysql'); # mysql -> pg $a3->db($db_pg); $a3->save(insert => 1); $a3 = Code->new(id1 => 1, id2 => 5, id3 => 6, db => $db_pg)->load; is($a3->name, 'Thr', 'multi-pk mysql -> pg'); # mysql -> pg with schema $a3->db($db_ws); $a3->save(insert => 1); $a3 = Code->new(id1 => 1, id2 => 5, id3 => 6, db => $db_ws)->load; is($a3->name, 'Thr', 'multi-pk mysql -> pg with schema'); } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_private.rdbo_albums CASCADE'); $dbh->do('DROP TABLE rdbo_albums CASCADE'); $dbh->do('DROP TABLE rdbo_codes CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.rdbo_codes CASCADE'); $dbh->do('DROP SEQUENCE Rose_db_object_private.rdbo_seq CASCADE'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); } $dbh->do(<<"EOF"); CREATE TABLE rdbo_albums ( id SERIAL PRIMARY KEY, name VARCHAR(32) UNIQUE, artist VARCHAR(32), year INTEGER, dt TIMESTAMP ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.rdbo_albums ( id SERIAL PRIMARY KEY, name VARCHAR(32) UNIQUE, artist VARCHAR(32), year INTEGER, dt TIMESTAMP ) EOF $dbh->do('CREATE SEQUENCE Rose_db_object_private.rdbo_seq'); $dbh->do(<<"EOF"); CREATE TABLE rdbo_codes ( id1 SERIAL NOT NULL, id2 INT NOT NULL, id3 INT NOT NULL DEFAULT nextval('Rose_db_object_private.rdbo_seq'), name VARCHAR(32) UNIQUE, PRIMARY KEY(id1, id2, id3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.rdbo_codes ( id1 SERIAL NOT NULL, id2 INT NOT NULL, id3 INT NOT NULL DEFAULT nextval('Rose_db_object_private.rdbo_seq'), name VARCHAR(32) UNIQUE, PRIMARY KEY(id1, id2, id3) ) EOF $dbh->disconnect; Rose::DB->default_type('pg'); package Album; our @ISA = qw(Rose::DB::Object); Album->meta->table('rdbo_albums'); Album->meta->auto_initialize; package AlbumWS; our @ISA = qw(Rose::DB::Object); AlbumWS->meta->table('rdbo_albums'); AlbumWS->meta->schema('Rose_db_object_private'); AlbumWS->meta->auto_initialize; package Code; our @ISA = qw(Rose::DB::Object); Code->meta->table('rdbo_codes'); Code->meta->auto_initialize; } # # MySQL # eval { $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'mysql'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rdbo_albums CASCADE'); $dbh->do('DROP TABLE rdbo_codes CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE rdbo_albums ( id INT PRIMARY KEY AUTO_INCREMENT, name VARCHAR(32) UNIQUE, artist VARCHAR(32), year INTEGER, dt TIMESTAMP ) EOF $dbh->do(<<"EOF"); CREATE TABLE rdbo_codes ( id1 INT NOT NULL AUTO_INCREMENT, id2 INT NOT NULL, id3 INT NOT NULL, name VARCHAR(32) UNIQUE, PRIMARY KEY(id1, id2, id3) ) EOF $dbh->disconnect; } } END { # Delete test tables if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_private.rdbo_albums CASCADE'); $dbh->do('DROP TABLE rdbo_albums CASCADE'); $dbh->do('DROP TABLE rdbo_codes CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.rdbo_codes CASCADE'); $dbh->do('DROP SEQUENCE Rose_db_object_private.rdbo_seq CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rdbo_albums CASCADE'); $dbh->do('DROP TABLE rdbo_codes CASCADE'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-auto.t000755 000765 000120 00000105707 12103001255 017435 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 275; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Metadata::Auto::Generic'); } our($PG_HAS_CHKPASS, $HAVE_PG, $HAVE_MYSQL, $HAVE_INFORMIX); # # PostgreSQL # SKIP: foreach my $db_type (qw(pg pg_with_schema)) { skip("PostgreSQL tests", 140) unless($HAVE_PG); OVERRIDE_OK: { no warnings; *MyPgObject::init_db = sub { Rose::DB->new($db_type) }; } my $o = MyPgObject->new(name => 'John', k1 => 1, k2 => undef, k3 => 3); ok(ref $o && $o->isa('MyPgObject'), "new() 1 - $db_type"); $o->flag2('TRUE'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(7); $o->dp(37.3960614524039); $o->f8(37.3960614524039); ok($o->save, "save() 1 - $db_type"); is($o->id, 1, "auto-generated primary key - $db_type"); ok($o->load, "load() 1 - $db_type"); eval { $o->name('C' x 50) }; ok($@, "varchar overflow fatal - $db_type"); $o->name('John'); $o->code('A'); is($o->code, 'A ', "character padding - $db_type"); eval { $o->code('C' x 50) }; ok($@, "character overflow fatal - $db_type"); $o->code('C' x 6); my $ouk = MyPgObject->new(k1 => 1, k2 => undef, k3 => 3); ok($ouk->load, "load() uk 1 - $db_type"); ok(!$ouk->not_found, "not_found() uk 1 - $db_type"); is($ouk->id, 1, "load() uk 2 - $db_type"); is($ouk->name, 'John', "load() uk 3 - $db_type"); ok($ouk->save, "save() uk 1 - $db_type"); my $o2 = MyPgObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyPgObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, "act'ive", "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 7, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); my $clone = $o2->clone; ok($o2->start eq $clone->start, "clone() 1 - $db_type"); $clone->start->set(year => '1960'); ok($o2->start ne $clone->start, "clone() 2 - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyPgObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyPgObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->load, "load() 4 - $db_type"); SKIP: { if($PG_HAS_CHKPASS) { $o->{'password_encrypted'} = ':8R1Kf2nOS0bRE'; ok($o->password_is('xyzzy'), "chkpass() 1 - $db_type"); is($o->password, 'xyzzy', "chkpass() 2 - $db_type"); $o->password('foobar'); ok($o->password_is('foobar'), "chkpass() 3 - $db_type"); is($o->password, 'foobar', "chkpass() 4 - $db_type"); ok($o->save, "save() 3 - $db_type"); } else { skip("chkpass tests", 5); } } my $o5 = MyPgObject->new(id => $o->id); ok($o5->load, "load() 5 - $db_type"); SKIP: { if($PG_HAS_CHKPASS) { ok($o5->password_is('foobar'), "chkpass() 5 - $db_type"); is($o5->password, 'foobar', "chkpass() 6 - $db_type"); } else { skip("chkpass tests", 2); } } $o5->nums([ 4, 5, 6 ]); ok($o5->save, "save() 4 - $db_type"); ok($o->load, "load() 6 - $db_type"); is($o5->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o5->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o5->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o5->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); ok($o->delete, "delete() - $db_type"); $o = MyPgObject->new(name => 'John', id => 9); $o->save_col(22); ok($o->save, "save() 4 - $db_type"); $o->save_col(50); ok($o->save, "save() 5 - $db_type"); $ouk = MyPgObject->new(save_col => 50); ok($ouk->load, "load() aliased unique key - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, "alias_column() nonesuch - $db_type"); # This is okay now #eval { $o->meta->alias_column(id => 'foo') }; #ok($@, "alias_column() primary key - $db_type"); $o = MyPgObject->new(id => 777); $o->meta->error_mode('fatal'); $o->dbh->{'PrintError'} = 0; eval { $o->load }; ok($@ && $o->not_found, "load() not found fatal - $db_type"); $o->id('abc'); eval { $o->load }; ok($@ && !$o->not_found, "load() fatal - $db_type"); eval { $o->save }; ok($@, "save() fatal - $db_type"); $o->meta->error_mode('return'); # # Test code generation # my $chkpass = $PG_HAS_CHKPASS ? " password => { type => 'chkpass' },\n" : ''; is(MyPgObject->meta->perl_columns_definition(braces => 'bsd', indent => 2), <<"EOF", "perl_columns_definition 1 - $db_type"); __PACKAGE__->meta->columns ( id => { type => 'integer', not_null => 1, sequence => 'rose_db_object_test_seq' }, k1 => { type => 'integer' }, k2 => { type => 'integer' }, k3 => { type => 'integer' }, $chkpass name => { type => 'varchar', length => 32, not_null => 1 }, code => { type => 'character', length => 6 }, flag => { type => 'boolean', default => 'true', not_null => 1 }, flag2 => { type => 'boolean' }, status => { type => 'varchar', default => 'act\\'ive', length => 32 }, bits => { type => 'bitfield', bits => 5, default => '00101', not_null => 1 }, start => { type => 'date', default => '1980-12-24' }, save => { type => 'integer', alias => 'save_col' }, nums => { type => 'array' }, dp => { type => 'double precision' }, f8 => { type => 'double precision' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); EOF $chkpass = $PG_HAS_CHKPASS ? " password => { type => 'chkpass' },\n" : ''; is(MyPgObject->meta->perl_columns_definition(braces => 'k&r', indent => 4), <<"EOF", "perl_columns_definition 2 - $db_type"); __PACKAGE__->meta->columns( id => { type => 'integer', not_null => 1, sequence => 'rose_db_object_test_seq' }, k1 => { type => 'integer' }, k2 => { type => 'integer' }, k3 => { type => 'integer' }, $chkpass name => { type => 'varchar', length => 32, not_null => 1 }, code => { type => 'character', length => 6 }, flag => { type => 'boolean', default => 'true', not_null => 1 }, flag2 => { type => 'boolean' }, status => { type => 'varchar', default => 'act\\'ive', length => 32 }, bits => { type => 'bitfield', bits => 5, default => '00101', not_null => 1 }, start => { type => 'date', default => '1980-12-24' }, save => { type => 'integer', alias => 'save_col' }, nums => { type => 'array' }, dp => { type => 'double precision' }, f8 => { type => 'double precision' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); EOF $chkpass = $PG_HAS_CHKPASS ? " password => { type => 'chkpass' },\n" : ''; is(MyPgObject->meta->perl_columns_definition, <<"EOF", "perl_columns_definition 3 - $db_type"); __PACKAGE__->meta->columns( id => { type => 'integer', not_null => 1, sequence => 'rose_db_object_test_seq' }, k1 => { type => 'integer' }, k2 => { type => 'integer' }, k3 => { type => 'integer' }, $chkpass name => { type => 'varchar', length => 32, not_null => 1 }, code => { type => 'character', length => 6 }, flag => { type => 'boolean', default => 'true', not_null => 1 }, flag2 => { type => 'boolean' }, status => { type => 'varchar', default => 'act\\'ive', length => 32 }, bits => { type => 'bitfield', bits => 5, default => '00101', not_null => 1 }, start => { type => 'date', default => '1980-12-24' }, save => { type => 'integer', alias => 'save_col' }, nums => { type => 'array' }, dp => { type => 'double precision' }, f8 => { type => 'double precision' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); EOF is(MyPgObject->meta->perl_unique_keys_definition, <<'EOF', "perl_unique_keys_definition 1 - $db_type"); __PACKAGE__->meta->unique_keys( [ 'k1', 'k2', 'k3' ], [ 'save' ], ); EOF my($v1, $v2, $v3) = split(/\./, $DBD::Pg::VERSION); if($v1 >= 2 && $v2 >= 19) { is(MyPgObject->meta->perl_unique_keys_definition(style => 'object', braces => 'bsd', indent => 2), <<'EOF', "perl_unique_keys_definition 2 - $db_type"); __PACKAGE__->meta->unique_keys ( Rose::DB::Object::Metadata::UniqueKey->new(name => 'rose_db_object_test_k1_k2_k3_key', columns => [ 'k1', 'k2', 'k3' ]), Rose::DB::Object::Metadata::UniqueKey->new(name => 'rose_db_object_test_save_key', columns => [ 'save' ]), ); EOF } else { is(MyPgObject->meta->perl_unique_keys_definition(style => 'object', braces => 'bsd', indent => 2), <<'EOF', "perl_unique_keys_definition 2 - $db_type"); __PACKAGE__->meta->unique_keys ( Rose::DB::Object::Metadata::UniqueKey->new(name => 'rose_db_object_test_k1_key', columns => [ 'k1', 'k2', 'k3' ]), Rose::DB::Object::Metadata::UniqueKey->new(name => 'rose_db_object_test_save_key', columns => [ 'save' ]), ); EOF } is(MyPgObject->meta->perl_primary_key_columns_definition, qq(__PACKAGE__->meta->primary_key_columns([ 'id' ]);\n), "perl_primary_key_columns_definition - $db_type"); } # # MySQL # SKIP: foreach my $db_type ('mysql') { skip("MySQL tests", 67) unless($HAVE_MYSQL); Rose::DB->default_type($db_type); my $o = MyMySQLObject->new(name => 'John', k1 => 1, k2 => undef, k3 => 3); ok(ref $o && $o->isa('MyMySQLObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(22); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); is(ref $o->dt_default, 'DateTime', "now() default - $db_type"); eval { $o->name('C' x 50) }; ok($@, "varchar overflow fatal - $db_type"); $o->name('John'); $o->code('A'); is($o->code, 'A ', "character padding - $db_type"); eval { $o->code('C' x 50) }; ok($@, "character overflow fatal - $db_type"); $o->code('C' x 6); is($o->enums, 'foo', "enum 1 - $db_type"); eval { $o->enums('blee') }; ok($@, "enum 2 - $db_type"); $o->enums('bar'); my $ouk = MyMySQLObject->new(k1 => 1, k2 => undef, k3 => 3); ok($ouk->load, "load() uk 1 - $db_type"); ok(!$ouk->not_found, "not_found() uk 1 - $db_type"); is($ouk->id, 1, "load() uk 2 - $db_type"); is($ouk->name, 'John', "load() uk 3 - $db_type"); ok($ouk->save, "save() uk 1 - $db_type"); my $o2 = MyMySQLObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyMySQLObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, "act'ive", "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 22, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); my $clone = $o2->clone; ok($o2->start eq $clone->start, "clone() 1 - $db_type"); $clone->start->set(year => '1960'); ok($o2->start ne $clone->start, "clone() 2 - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyMySQLObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyMySQLObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); $o->nums([ 4, 5, 6, 'aaa', '"\\"' ]); ok($o->save, "save() 3 - $db_type"); ok($o->load, "load() 4 - $db_type"); is($o->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o->nums->[2], 6, "load() verify 12 (array value) - $db_type"); is($o->nums->[3], 'aaa', "load() verify (string in array value) - $db_type"); is($o->nums->[4], '"\\"', "load() verify (escapes in array value) - $db_type"); my @a = $o->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 5, "load() verify 16 (array value) - $db_type"); ok($o->delete, "delete() - $db_type"); $o = MyMySQLObject->new(name => 'John', id => 9); $o->save_col(22); ok($o->save, "save() 4 - $db_type"); $o->save_col(50); ok($o->save, "save() 5 - $db_type"); $ouk = MyMySQLObject->new(save_col => 50); ok($ouk->load, "load() aliased unique key - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, "alias_column() nonesuch - $db_type"); # This is okay now #eval { $o->meta->alias_column(id => 'foo') }; #ok($@, "alias_column() primary key - $db_type"); $o = MyMySQLObject->new(id => 777); $o->meta->error_mode('fatal'); $o->dbh->{'PrintError'} = 0; eval { $o->load }; ok($@ && $o->not_found, "load() not found fatal - $db_type"); my $old_table = $o->meta->table; $o->meta->table('nonesuch'); eval { $o->load }; ok($@ && !$o->not_found, "load() fatal - $db_type"); eval { $o->save }; ok($@, "save() fatal - $db_type"); $o->meta->table($old_table); $o->meta->error_mode('return'); $o = MyMPKMySQLObject->new(name => 'John'); ok($o->save, "save() 1 multi-value primary key with generated values - $db_type"); is($o->k1, 1, "save() verify 1 multi-value primary key with generated values - $db_type"); is($o->k2, 2, "save() verify 2 multi-value primary key with generated values - $db_type"); $o = MyMPKMySQLObject->new(name => 'Alex'); ok($o->save, "save() 2 multi-value primary key with generated values - $db_type"); is($o->k1, 3, "save() verify 3 multi-value primary key with generated values - $db_type"); is($o->k2, 4, "save() verify 4 multi-value primary key with generated values - $db_type"); $o = MyMySQLObject->new; is($o->enums, 'foo', "enum undef 1 - $db_type"); $o->meta->column('enums')->default(undef); $o->meta->make_column_methods(replace_existing => 1); $o->enums(undef); is($o->enums, undef, "enum undef 2 - $db_type"); } # # Informix # SKIP: foreach my $db_type ('informix') { skip("Informix tests", 66) unless($HAVE_INFORMIX); Rose::DB->default_type($db_type); my $o = MyInformixObject->new(name => 'John', id => 1, k1 => 1, k2 => undef, k3 => 3); ok(ref $o && $o->isa('MyInformixObject'), "new() 1 - $db_type"); $o->meta->allow_inline_column_values(1); $o->flag2('true'); $o->date_created('current year to fraction(5)'); $o->last_modified($o->date_created); $o->save_col(22); my $dt = DateTime->now(time_zone => 'floating'); $dt->set_nanosecond(123456789); $o->frac($dt->clone); $o->frac1($dt->clone); $o->frac2($dt->clone); $o->frac3($dt->clone); $o->frac4($dt->clone); $o->frac5($dt->clone); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); $o->htmin('8:01:12pm'); $o->htsec('5:56:55.1234am'); $o->htfr1('13:45:56.59999'); $o->htfr5('01:02:03.123456'); $o->save; $o->load; is($o->htmin, '20:01:00', "datetime hour to minute - $db_type"); is($o->htsec, '05:56:55', "datetime hour to second - $db_type"); is($o->htfr1, '13:45:56.5', "datetime hour to fraction(1) - $db_type"); is($o->htfr5, '01:02:03.12345', "datetime hour to fraction(5) - $db_type"); is(ref $o->other_date, 'DateTime', 'other_date 1'); is(ref $o->other_datetime, 'DateTime', 'other_datetime 1'); eval { $o->name('C' x 50) }; ok($@, "varchar overflow fatal - $db_type"); $o->name('John'); $o->code('A'); is($o->code, 'A ', "character padding - $db_type"); eval { $o->code('C' x 50) }; ok($@, "character overflow fatal - $db_type"); $o->code('C' x 6); my $ouk = MyInformixObject->new(k1 => 1, k2 => undef, k3 => 3); ok($ouk->load, "load() uk 1 - $db_type"); ok(!$ouk->not_found, "not_found() uk 1 - $db_type"); is($ouk->id, 1, "load() uk 2 - $db_type"); is($ouk->name, 'John', "load() uk 3 - $db_type"); ok($ouk->save, "save() uk 1 - $db_type"); my $o2 = MyInformixObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyInformixObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, "act'ive", "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 22, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); my $clone = $o2->clone; ok($o2->start eq $clone->start, "clone() 1 - $db_type"); $clone->start->set(year => '1960'); ok($o2->start ne $clone->start, "clone() 2 - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('current year to second'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyInformixObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyInformixObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); $o->nums([ 4, 5, 6 ]); $o->names([ qw(a b 3.1) ]); ok($o->save, "save() 3 - $db_type"); ok($o->load, "load() 4 - $db_type"); is($o->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o->nums->[2], 6, "load() verify 12 (array value) - $db_type"); $o->nums(7, 8, 9); my @a = $o->nums; is($a[0], 7, "load() verify 13 (array value) - $db_type"); is($a[1], 8, "load() verify 14 (array value) - $db_type"); is($a[2], 9, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); is($o->names->[0], 'a', "load() verify 10 (set value) - $db_type"); is($o->names->[1], 'b', "load() verify 11 (set value) - $db_type"); is($o->names->[2], '3.1', "load() verify 12 (set value) - $db_type"); $o->names('c', 'd', '4.2'); @a = $o->names; is($a[0], 'c', "load() verify 13 (set value) - $db_type"); is($a[1], 'd', "load() verify 14 (set value) - $db_type"); is($a[2], '4.2', "load() verify 15 (set value) - $db_type"); is(@a, 3, "load() verify 16 (set value) - $db_type"); ok($o->delete, "delete() - $db_type"); $o = MyInformixObject->new(name => 'John', id => 9); $o->flag2('true'); $o->date_created('current year to fraction(5)'); $o->last_modified($o->date_created); $o->save_col(22); ok($o->save, "save() 4 - $db_type"); $o->save_col(50); ok($o->save, "save() 5 - $db_type"); $ouk = MyInformixObject->new(save_col => 50); ok($ouk->load, "load() aliased unique key - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, "alias_column() nonesuch - $db_type"); # This is okay now #eval { $o->meta->alias_column(id => 'foo') }; #ok($@, "alias_column() primary key - $db_type"); $o = MyInformixObject->new(id => 777); $o->meta->error_mode('fatal'); $o->dbh->{'PrintError'} = 0; eval { $o->load }; ok($@ && $o->not_found, "load() not found fatal - $db_type"); $o->id('abc'); eval { $o->load }; ok($@ && !$o->not_found, "load() fatal - $db_type"); eval { $o->save }; ok($@, "save() fatal - $db_type"); $o->meta->error_mode('return'); } BEGIN { # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_PG = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_chkpass_test'); $dbh->do('DROP SEQUENCE Rose_db_object_test_seq'); $dbh->do('DROP SEQUENCE Rose_db_object_private.Rose_db_object_test_seq'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); } our $PG_HAS_CHKPASS = pg_has_chkpass(); $dbh->do('CREATE SEQUENCE Rose_db_object_test_seq'); my $pg_vers = $dbh->{'pg_server_version'}; my $active = $pg_vers >= 80100 ? q('act''ive') : q('act\'ive'); $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_test ( id INT DEFAULT nextval('Rose_db_object_test_seq') NOT NULL PRIMARY KEY, k1 INT, k2 INT, k3 INT, @{[ $PG_HAS_CHKPASS ? 'password CHKPASS,' : '' ]} name VARCHAR(32) NOT NULL, code CHAR(6), flag BOOLEAN NOT NULL DEFAULT 't', flag2 BOOLEAN, status VARCHAR(32) DEFAULT $active, bits BIT(5) NOT NULL DEFAULT B'00101', start DATE DEFAULT '1980-12-24', save INT, nums INT[], dp DOUBLE PRECISION, f8 FLOAT8, last_modified TIMESTAMP, date_created TIMESTAMP, UNIQUE(save), UNIQUE(k1, k2, k3) ) EOF $dbh->do('CREATE SEQUENCE Rose_db_object_private.Rose_db_object_test_seq'); $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.Rose_db_object_test ( id INT DEFAULT nextval('Rose_db_object_test_seq') NOT NULL PRIMARY KEY, k1 INT, k2 INT, k3 INT, @{[ $PG_HAS_CHKPASS ? 'password CHKPASS,' : '' ]} name VARCHAR(32) NOT NULL, code CHAR(6), flag BOOLEAN NOT NULL DEFAULT 't', flag2 BOOLEAN, status VARCHAR(32) DEFAULT $active, bits BIT(5) NOT NULL DEFAULT B'00101', start DATE DEFAULT '1980-12-24', save INT, nums INT[], dp DOUBLE PRECISION, f8 FLOAT8, last_modified TIMESTAMP, date_created TIMESTAMP, UNIQUE(save), UNIQUE(k1, k2, k3) ) EOF $dbh->disconnect; # Create test subclass package MyPgObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } MyPgObject->meta->table('Rose_db_object_test'); MyPgObject->meta->auto_initialize; package MyPgObjectEvalTest; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } eval 'package MyPgObjectEvalTest; ' . MyPgObject->meta->perl_columns_definition; Test::More::ok(!$@, 'perl_columns_definition eval - pg'); eval 'package MyPgObjectEvalTest; ' . MyPgObject->meta->perl_unique_keys_definition; Test::More::ok(!$@, 'perl_unique_keys_definition eval 1 - pg'); eval 'package MyPgObjectEvalTest; ' . MyPgObject->meta->perl_unique_keys_definition(style => 'object'); Test::More::ok(!$@, 'perl_unique_keys_definition eval 2 - pg'); eval 'package MyPgObjectEvalTest; ' . MyPgObject->meta->perl_primary_key_columns_definition; Test::More::ok(!$@, 'perl_primary_key_columns_definition eval - pg'); } # # MySQL # my $db_version; eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh() or die Rose::DB->error; $db_version = $db->database_version; }; if(!$@ && $dbh) { our $HAVE_MYSQL = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_test'); $dbh->do('DROP TABLE Rose_db_object_test2'); } # MySQL 5.0.3 or later has a completely stupid "native" BIT type # which we want to avoid because DBI's column_info() method prints # a warning when it encounters such a column. my $bit_col = ($db_version >= 5_000_003) ? q(bits TINYINT(1) NOT NULL DEFAULT '00101') : q(bits BIT(5) NOT NULL DEFAULT '00101'); $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_test ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, k1 INT, k2 INT, k3 INT, name VARCHAR(32) NOT NULL, code CHAR(6), flag TINYINT(1) NOT NULL DEFAULT 1, flag2 TINYINT(1), status VARCHAR(32) DEFAULT 'act''ive', $bit_col, nums VARCHAR(255), start DATE DEFAULT '1980-12-24', save INT, enums ENUM ('foo', 'bar', 'baz') DEFAULT 'foo', dt_default TIMESTAMP DEFAULT NOW(), last_modified TIMESTAMP, date_created DATETIME, UNIQUE(save), UNIQUE(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_test2 ( k1 INT NOT NULL, k2 INT NOT NULL, name VARCHAR(32), UNIQUE(k1, k2) ) EOF $dbh->disconnect; package MyMySQLMeta; our @ISA = qw(Rose::DB::Object::Metadata); MyMySQLMeta->column_type_class(int => 'Rose::DB::Object::Metadata::Column::Varchar'); # Create test subclass package MyMySQLObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub meta_class { 'MyMySQLMeta' } sub init_db { Rose::DB->new('mysql') } MyMySQLObject->meta->allow_inline_column_values(1); MyMySQLObject->meta->table('Rose_db_object_test'); MyMySQLObject->meta->columns(MyMySQLObject->meta->auto_generate_columns); # Account for bugs in DBD::mysql's column_info implementation # CHAR(6) column shows up as VARCHAR(6) MyMySQLObject->meta->column(code => { type => 'char', length => 6 }); # BIT(5) column shows up as TINYINT(1) MyMySQLObject->meta->column(bits => { type => 'bitfield', bits => 5, default => 101 }); # BOOLEAN column shows up as TINYINT(1) even if you use the # BOOLEAN keyword (which is not supported prior to MySQL 4.1, # so we're actually using TINYINT(1) in the definition above) MyMySQLObject->meta->column(flag => { type => 'boolean', default => 1 }); MyMySQLObject->meta->column(flag2 => { type => 'boolean' }); # No native support for array types in MySQL MyMySQLObject->meta->column(nums => { type => 'array' }); # Test preservation of existing columns MyMySQLObject->meta->delete_column('k3'); MyMySQLObject->meta->auto_init_columns; Test::More::is(MyMySQLObject->meta->column('k3')->type, 'varchar', 'custom column class - mysql'); Test::More::ok(MyMySQLObject->meta->isa('MyMySQLMeta'), 'metadata subclass - mysql'); MyMySQLObject->meta->primary_key_columns(MyMySQLObject->meta->auto_retrieve_primary_key_column_names); MyMySQLObject->meta->add_unique_key('save'); MyMySQLObject->meta->auto_init_unique_keys; MyMySQLObject->meta->initialize; package MyMPKMySQLObject; use Rose::DB::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } MyMPKMySQLObject->meta->table('Rose_db_object_test2'); MyMPKMySQLObject->meta->columns(MyMPKMySQLObject->meta->auto_generate_columns); # Not-null int columns default to 0 even if you do not set a default. # MySQL sucks. MyMPKMySQLObject->meta->column('k1')->default(undef); MyMPKMySQLObject->meta->column('k2')->default(undef); MyMPKMySQLObject->meta->primary_key_columns('k1', 'k2'); MyMPKMySQLObject->meta->initialize; my $i = 1; MyMPKMySQLObject->meta->primary_key_generator(sub { my($meta, $db) = @_; my $k1 = $i++; my $k2 = $i++; return $k1, $k2; }); } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_INFORMIX = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_test2 CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, k1 INT, k2 INT, k3 INT, name VARCHAR(32) NOT NULL, code CHAR(6), flag BOOLEAN DEFAULT 't' NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'act''ive', bits VARCHAR(5) DEFAULT '00101' NOT NULL, nums VARCHAR(255), start DATE DEFAULT '12/24/1980', save INT, names SET(VARCHAR(64) NOT NULL), last_modified DATETIME YEAR TO FRACTION(5), date_created DATETIME YEAR TO FRACTION(5), other_date DATE DEFAULT TODAY, other_datetime DATETIME YEAR TO FRACTION(5) DEFAULT CURRENT YEAR TO FRACTION(5), frac DATETIME YEAR TO FRACTION, frac1 DATETIME YEAR TO FRACTION(1), frac2 DATETIME YEAR TO FRACTION(2), frac3 DATETIME YEAR TO FRACTION(3), frac4 DATETIME YEAR TO FRACTION(4), frac5 DATETIME YEAR TO FRACTION(5), htmin DATETIME HOUR TO MINUTE, htsec DATETIME HOUR TO SECOND, htfr1 DATETIME HOUR TO FRACTION(1), htfr5 DATETIME HOUR TO FRACTION(5) ) EOF $dbh->do(<<"EOF"); CREATE UNIQUE INDEX Rose_db_object_test_k1_idx ON Rose_db_object_test (k1, k2, k3); EOF $dbh->do(<<"EOF"); CREATE UNIQUE INDEX Rose_db_object_test_save_idx ON Rose_db_object_test (save); EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_test2 ( k1 INT NOT NULL, k2 INT NOT NULL, name VARCHAR(32) ) EOF $dbh->do(<<"EOF"); ALTER TABLE Rose_db_object_test2 ADD CONSTRAINT PRIMARY KEY (k1, k2) EOF $dbh->disconnect; # Create test subclass package MyMPKInformixObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('informix') } MyMPKInformixObject->meta->table('Rose_db_object_test2'); MyMPKInformixObject->meta->auto_init_primary_key_columns; my @pk = MyMPKInformixObject->meta->primary_key_columns; Test::More::is_deeply(\@pk, [ qw(k1 k2) ], 'auto_init_primary_key_columns - informix'); package MyInformixObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('informix') } MyInformixObject->meta->table('Rose_db_object_test'); MyInformixObject->meta->columns(MyInformixObject->meta->auto_generate_columns); # No native support for bit types in Informix MyInformixObject->meta->column(bits => { type => 'bitfield', bits => 5, default => 101 }); # No native support for array types in Informix MyInformixObject->meta->column(nums => { type => 'array' }); MyInformixObject->meta->auto_init_primary_key_columns; MyInformixObject->meta->auto_init_unique_keys; MyInformixObject->meta->prepare_options({ ix_CursorWithHold => 1 }); MyInformixObject->meta->initialize; } } END { # Delete test table if($HAVE_PG) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_test CASCADE'); $dbh->do('DROP SEQUENCE Rose_db_object_test_seq'); $dbh->do('DROP SEQUENCE Rose_db_object_private.Rose_db_object_test_seq'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->disconnect; } if($HAVE_MYSQL) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_test2 CASCADE'); $dbh->disconnect; } if($HAVE_INFORMIX) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_test2 CASCADE'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-cached.t000755 000765 000120 00000112377 12207467411 017714 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 448; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Cached'); } our($PG_HAS_CHKPASS, $HAVE_PG, $HAVE_MYSQL, $HAVE_INFORMIX, $HAVE_SQLITE); # # Generic # foreach my $pair ((map { [ "2 $_", 2 ] } qw(s sec secs second seconds)), (map { [ "2 $_", 2 * 60 ] } qw(m min mins minute minutes)), (map { [ "2 $_", 2 * 60 * 60 ] } qw(h hr hrs hour hours)), (map { [ "2 $_", 2 * 60 * 60 * 24 ] } qw(d day days)), (map { [ "2 $_", 2 * 60 * 60 * 24 * 7 ] } qw(w wk wks week weeks)), (map { [ "2 $_", 2 * 60 * 60 * 24 * 365 ] } qw(y yr yrs year years))) { my($arg, $secs) = @$pair; MyCachedObject->meta->cached_objects_expire_in($arg); is(MyCachedObject->meta->cached_objects_expire_in, $secs, "cache_expires_in($arg) - generic"); $arg =~ s/\s+//g; MyCachedObject->meta->cached_objects_expire_in($arg); is(MyCachedObject->meta->cached_objects_expire_in, $secs, "cache_expires_in($arg) - generic"); MyCachedObject->cached_objects_expire_in($arg); my $object = MyCachedObject->new; is($object->cached_objects_expire_in, MyCachedObject->cached_objects_expire_in, 'object inherited expires'); } # # PostgreSQL # SKIP: foreach my $db_type (qw(pg pg_with_schema)) { skip("PostgreSQL tests", 159) unless($HAVE_PG); Rose::DB->default_type($db_type); TEST_HACK: { no warnings; *MyPgObject::init_db = sub { Rose::DB->new($db_type) }; } my $of = MyPgObject->new(name => 'John', id => 99); ok(ref $of && $of->isa('MyPgObject'), "cached new() 1 - $db_type"); ok($of->save, "save() 1 - $db_type"); my $of2 = MyPgObject->new(id => $of->id); ok(ref $of2 && $of2->isa('MyPgObject'), "cached new() 2 - $db_type"); ok($of2->load, "cached load() - $db_type"); is($of2->name, $of->name, "load() verify 1 - $db_type"); my $of3 = MyPgObject->new(id => $of2->id); ok(ref $of3 && $of3->isa('MyPgObject'), "cached new() 3 - $db_type"); ok($of3->load, "cached load() - $db_type"); is($of3->name, $of2->name, "cached load() verify 2 - $db_type"); is($of3, $of2, "load() verify cached 1 - $db_type"); is($of2, $of, "load() verify cached 2 - $db_type"); my $ouk = MyPgObject->new(name => $of->name); ok($ouk->load, "cached load() unique key - $db_type"); is($ouk, $of, "load() verify cached unique key 1 - $db_type"); is($ouk, $of2, "load() verify cached unique key 2 - $db_type"); is($ouk, $of3, "load() verify cached unique key 3 - $db_type"); is(keys %MyPgObject::Objects_By_Id, 1, "cache check 1 - $db_type"); ok($of->forget, "forget() - $db_type"); is(keys %MyPgObject::Objects_By_Id, 0, "cache check 2 - $db_type"); # Standard tests my $o = MyPgObject->new(name => 'John x', id => 1); ok(ref $o && $o->isa('MyPgObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(7); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); my $o2 = MyPgObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyPgObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 7, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified eq $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyPgObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyPgObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->load, "load() 4 - $db_type"); SKIP: { if($PG_HAS_CHKPASS) { $o->{'password_encrypted'} = ':8R1Kf2nOS0bRE'; ok($o->password_is('xyzzy'), "chkpass() 1 - $db_type"); is($o->password, 'xyzzy', "chkpass() 2 - $db_type"); $o->password('foobar'); ok($o->password_is('foobar'), "chkpass() 3 - $db_type"); is($o->password, 'foobar', "chkpass() 4 - $db_type"); ok($o->save, "save() 3 - $db_type"); } else { skip("chkpass tests", 5); } } my $o5 = MyPgObject->new(id => $o->id); ok($o5->load, "load() 5 - $db_type"); SKIP: { if($PG_HAS_CHKPASS) { ok($o5->password_is('foobar'), "chkpass() 5 - $db_type"); is($o5->password, 'foobar', "chkpass() 6 - $db_type"); } else { skip("chkpass tests", 2); } } $o5->nums([ 4, 5, 6 ]); ok($o5->save, "save() 4 - $db_type"); ok($o->load, "load() 6 - $db_type"); is($o5->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o5->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o5->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o5->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 6 (array value) - $db_type"); ok(exists $MyPgObject::Objects_By_Id{$o->id}, "pre delete and forget pk - $db_type"); ok(exists $MyPgObject::Objects_By_Key{'name'}{$o->name}, "pre delete and forget uk - $db_type"); ok($o->delete, "delete() - $db_type"); ok(!exists $MyPgObject::Objects_By_Id{$o->id}, "post delete and forget pk - $db_type"); ok(!exists $MyPgObject::Objects_By_Key{'name'}{$o->name}, "post delete and forget uk - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, "alias_column() nonesuch - $db_type"); $o2->forget; $o = MyPgObject->new(name => 'John'); ok($o->load, "load() forget 1 - $db_type"); $o->forget; $o2 = MyPgObject->new(name => 'John'); ok($o2->load, "load() forget 2 - $db_type"); ok($o ne $o2, "load() forget 3 - $db_type"); $o->meta->clear_object_cache; FORGET_ALL_PG: { no warnings; is(scalar keys %MyPgObject::Objects_By_Id, 0, "clear_object_cache() 1 - $db_type"); is(scalar keys %MyPgObject::Objects_By_Key, 0, "clear_object_cache() 2 - $db_type"); is(scalar keys %MyPgObject::Objects_Keys, 0, "clear_object_cache() 3 - $db_type"); } # Cache expiration with primary key MyPgObject->meta->cached_objects_expire_in('5 seconds'); $o = MyPgObject->new(id => 99); $o->load or die $o->error; my $loaded = $MyPgObject::Objects_By_Id_Loaded{99}; is($MyPgObject::Objects_By_Id_Loaded{99}, $loaded, "cache_expires_in pk 1 - $db_type"); $o->load or die $o->error; is($MyPgObject::Objects_By_Id_Loaded{99}, $loaded, "cache_expires_in pk 2 - $db_type"); sleep(5); $o->load or die $o->error; ok($MyPgObject::Objects_By_Id_Loaded{99} != $loaded, "cache_expires_in pk 3 - $db_type"); # Cache expiration with unique key MyPgObject->meta->cached_objects_expire_in('5 seconds'); $o = MyPgObject->new(name => 'John'); $o->load or die $o->error; $loaded = $MyPgObject::Objects_By_Key_Loaded{'name'}{'John'}; is($MyPgObject::Objects_By_Key_Loaded{'name'}{'John'}, $loaded, "cache_expires_in uk 1 - $db_type"); $o->load or die $o->error; is($MyPgObject::Objects_By_Key_Loaded{'name'}{'John'}, $loaded, "cache_expires_in uk 2 - $db_type"); sleep(5); $o->load or die $o->error; ok($MyPgObject::Objects_By_Key_Loaded{'name'}{'John'} != $loaded, "cache_expires_in uk 3 - $db_type"); } # # MySQL # SKIP: foreach my $db_type ('mysql') { skip("MySQL tests", 61) unless($HAVE_MYSQL); Rose::DB->default_type($db_type); my $opk = MyMySQLObject->new(name => 'John', id => 199); $opk->remember_by_primary_key; $opk = MyMySQLObject->new(name => 'John'); ok(!$opk->load(speculative => 1), "remember_by_primary_key() 1 - $db_type"); $opk = MyMySQLObject->new(id => 199); ok($opk->load(speculative => 1), "remember_by_primary_key() 2 - $db_type"); $opk->forget; my $of = MyMySQLObject->new(name => 'John'); ok(ref $of && $of->isa('MyMySQLObject'), "cached new() 1 - $db_type"); ok($of->save, 'save() 1'); my $of2 = MyMySQLObject->new(id => $of->id); ok(ref $of2 && $of2->isa('MyMySQLObject'), "cached new() 2 - $db_type"); ok($of2->load, "cached load() - $db_type"); is($of2->name, $of->name, 'load() verify 1'); my $of3 = MyMySQLObject->new(id => $of2->id); ok(ref $of3 && $of3->isa('MyMySQLObject'), "cached new() 3 - $db_type"); ok($of3->load, "cached load() - $db_type"); is($of3->name, $of2->name, "cached load() verify 2 - $db_type"); is($of3, $of2, "load() verify cached 1 - $db_type"); is($of2, $of, "load() verify cached 2 - $db_type"); my $ouk = MyMySQLObject->new(name => $of->name); ok($ouk->load, "cached load() unique key - $db_type"); is($ouk, $of, "load() verify cached unique key 1 - $db_type"); is($ouk, $of2, "load() verify cached unique key 2 - $db_type"); is($ouk, $of3, "load() verify cached unique key 3 - $db_type"); is(keys %MyMySQLObject::Objects_By_Id, 1, "cache check 1 - $db_type"); ok($of->forget, 'forget()'); is(keys %MyMySQLObject::Objects_By_Id, 0, "cache check 2 - $db_type"); # Standard tests my $o = MyMySQLObject->new(name => 'John x'); ok(ref $o && $o->isa('MyMySQLObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(22); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); my $o2 = MyMySQLObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyMySQLObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 22, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified eq $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyMySQLObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyMySQLObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->delete, "delete() - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, 'alias_column() nonesuch'); $o = MyMySQLObject->new(name => 'John'); ok($o->load, "load() forget 1 - $db_type"); $o->forget; $o2 = MyMySQLObject->new(name => 'John'); ok($o2->load, "load() forget 2 - $db_type"); ok($o ne $o2, "load() forget 3 - $db_type"); $o->meta->clear_object_cache; FORGET_ALL_MYSQL: { no warnings; is(scalar keys %MyMySQLObject::Objects_By_Id, 0, "clear_object_cache() 1 - $db_type"); is(scalar keys %MyMySQLObject::Objects_By_Key, 0, "clear_object_cache() 2 - $db_type"); is(scalar keys %MyMySQLObject::Objects_Keys, 0, "clear_object_cache() 3 - $db_type"); } my $id = $o->id; # Cache expiration with primary key MyMySQLObject->meta->cached_objects_expire_in('5 seconds'); $o = MyMySQLObject->new(id => $id); $o->load or die $o->error; my $loaded = $MyMySQLObject::Objects_By_Id_Loaded{$id}; is($MyMySQLObject::Objects_By_Id_Loaded{$id}, $loaded, "cache_expires_in pk 1 - $db_type"); $o->load or die $o->error; is($MyMySQLObject::Objects_By_Id_Loaded{$id}, $loaded, "cache_expires_in pk 2 - $db_type"); sleep(5); $o->load or die $o->error; ok($MyMySQLObject::Objects_By_Id_Loaded{$id} != $loaded, "cache_expires_in pk 3 - $db_type"); # Cache expiration with unique key MyMySQLObject->meta->cached_objects_expire_in('5 seconds'); $o = MyMySQLObject->new(name => 'John'); $o->load or die $o->error; $loaded = $MyMySQLObject::Objects_By_Key_Loaded{'name'}{'John'}; is($MyMySQLObject::Objects_By_Key_Loaded{'name'}{'John'}, $loaded, "cache_expires_in uk 1 - $db_type"); $o->load or die $o->error; is($MyMySQLObject::Objects_By_Key_Loaded{'name'}{'John'}, $loaded, "cache_expires_in uk 2 - $db_type"); sleep(5); $o->load or die $o->error; ok($MyMySQLObject::Objects_By_Key_Loaded{'name'}{'John'} != $loaded, "cache_expires_in uk 3 - $db_type"); } # # Informix # SKIP: foreach my $db_type (qw(informix)) { skip("Informix tests", 70) unless($HAVE_INFORMIX); Rose::DB->default_type($db_type); my $of = MyInformixObject->new(name => 'John', id => 99); ok(ref $of && $of->isa('MyInformixObject'), "cached new() 1 - $db_type"); ok($of->save, "save() 1 - $db_type"); my $of2 = MyInformixObject->new(id => $of->id); ok(ref $of2 && $of2->isa('MyInformixObject'), "cached new() 2 - $db_type"); ok($of2->load, "cached load() - $db_type"); is($of2->name, $of->name, "load() verify 1 - $db_type"); my $of3 = MyInformixObject->new(id => $of2->id); ok(ref $of3 && $of3->isa('MyInformixObject'), "cached new() 3 - $db_type"); ok($of3->load, "cached load() - $db_type"); is($of3->name, $of2->name, "cached load() verify 2 - $db_type"); is($of3, $of2, "load() verify cached 1 - $db_type"); is($of2, $of, "load() verify cached 2 - $db_type"); my $ouk = MyInformixObject->new(name => $of->name); ok($ouk->load, "cached load() unique key - $db_type"); is($ouk, $of, "load() verify cached unique key 1 - $db_type"); is($ouk, $of2, "load() verify cached unique key 2 - $db_type"); is($ouk, $of3, "load() verify cached unique key 3 - $db_type"); is(keys %MyInformixObject::Objects_By_Id, 1, "cache check 1 - $db_type"); ok($of->forget, "forget() - $db_type"); is(keys %MyInformixObject::Objects_By_Id, 0, "cache check 2 - $db_type"); # Standard tests my $o = MyInformixObject->new(name => 'John x', id => 1); ok(ref $o && $o->isa('MyInformixObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(7); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); my $o2 = MyInformixObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyInformixObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 7, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified eq $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyInformixObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyInformixObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->load, "load() 4 - $db_type"); my $o5 = MyInformixObject->new(id => $o->id); ok($o5->load, "load() 5 - $db_type"); $o5->nums([ 4, 5, 6 ]); ok($o5->save, "save() 4 - $db_type"); ok($o->load, "load() 6 - $db_type"); is($o5->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o5->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o5->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o5->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 6 (array value) - $db_type"); ok($o->delete, "delete() - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, 'alias_column() nonesuch'); $o2->forget; $o = MyInformixObject->new(name => 'John'); ok($o->load, "load() forget 1 - $db_type"); $o->forget; $o2 = MyInformixObject->new(name => 'John'); ok($o2->load, "load() forget 2 - $db_type"); ok($o ne $o2, "load() forget 3 - $db_type"); $o->meta->clear_object_cache; FORGET_ALL_INFORMIX: { no warnings; is(scalar keys %MyInformixObject::Objects_By_Id, 0, "clear_object_cache() 1 - $db_type"); is(scalar keys %MyInformixObject::Objects_By_Key, 0, "clear_object_cache() 2 - $db_type"); is(scalar keys %MyInformixObject::Objects_Keys, 0, "clear_object_cache() 3 - $db_type"); } # Cache expiration with primary key MyInformixObject->meta->cached_objects_expire_in('5 seconds'); $o = MyInformixObject->new(id => 99); $o->load or die $o->error; my $loaded = $MyInformixObject::Objects_By_Id_Loaded{99}; is($MyInformixObject::Objects_By_Id_Loaded{99}, $loaded, "cache_expires_in pk 1 - $db_type"); $o->load or die $o->error; is($MyInformixObject::Objects_By_Id_Loaded{99}, $loaded, "cache_expires_in pk 2 - $db_type"); sleep(5); $o->load or die $o->error; ok($MyInformixObject::Objects_By_Id_Loaded{99} != $loaded, "cache_expires_in pk 3 - $db_type"); # Cache expiration with unique key MyInformixObject->meta->cached_objects_expire_in('5 seconds'); $o = MyInformixObject->new(name => 'John'); $o->load or die $o->error; $loaded = $MyInformixObject::Objects_By_Key_Loaded{'name'}{'John'}; is($MyInformixObject::Objects_By_Key_Loaded{'name'}{'John'}, $loaded, "cache_expires_in uk 1 - $db_type"); $o->load or die $o->error; is($MyInformixObject::Objects_By_Key_Loaded{'name'}{'John'}, $loaded, "cache_expires_in uk 2 - $db_type"); sleep(5); $o->load or die $o->error; ok($MyInformixObject::Objects_By_Key_Loaded{'name'}{'John'} != $loaded, "cache_expires_in uk 3 - $db_type"); $o->meta->clear_object_cache; } # # SQLite # SKIP: foreach my $db_type (qw(sqlite)) { skip("SQLite tests", 73) unless($HAVE_SQLITE); Rose::DB->default_type($db_type); my $opk = MySQLiteObject->new(name => 'John', id => 199); $opk->remember_by_primary_key; $opk = MySQLiteObject->new(name => 'John'); ok(!$opk->load(speculative => 1), "remember_by_primary_key() 1 - $db_type"); $opk = MySQLiteObject->new(id => 199); ok($opk->load(speculative => 1), "remember_by_primary_key() 2 - $db_type"); $opk->forget; my $of = MySQLiteObject->new(name => 'John', id => 99); ok(ref $of && $of->isa('MySQLiteObject'), "cached new() 1 - $db_type"); ok($of->save, "save() 1 - $db_type"); my $of2 = MySQLiteObject->new(id => $of->id); ok(ref $of2 && $of2->isa('MySQLiteObject'), "cached new() 2 - $db_type"); ok($of2->load, "cached load() - $db_type"); is($of2->name, $of->name, "load() verify 1 - $db_type"); my $of3 = MySQLiteObject->new(id => $of2->id); ok(ref $of3 && $of3->isa('MySQLiteObject'), "cached new() 3 - $db_type"); ok($of3->load, "cached load() - $db_type"); is($of3->name, $of2->name, "cached load() verify 2 - $db_type"); is($of3, $of2, "load() verify cached 1 - $db_type"); is($of2, $of, "load() verify cached 2 - $db_type"); my $ouk = MySQLiteObject->new(name => $of->name); ok($ouk->load, "cached load() unique key - $db_type"); is($ouk, $of, "load() verify cached unique key 1 - $db_type"); is($ouk, $of2, "load() verify cached unique key 2 - $db_type"); is($ouk, $of3, "load() verify cached unique key 3 - $db_type"); is(keys %MySQLiteObject::Objects_By_Id, 1, "cache check 1 - $db_type"); ok($of->forget, "forget() - $db_type"); is(keys %MySQLiteObject::Objects_By_Id, 0, "cache check 2 - $db_type"); # Standard tests my $o = MySQLiteObject->new(name => 'John x', id => 1); ok(ref $o && $o->isa('MySQLiteObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(7); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); my $o2 = MySQLiteObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MySQLiteObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 7, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified eq $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MySQLiteObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MySQLiteObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->load, "load() 4 - $db_type"); my $o5 = MySQLiteObject->new(id => $o->id); ok($o5->load, "load() 5 - $db_type"); $o5->nums([ 4, 5, 6 ]); ok($o5->save, "save() 4 - $db_type"); ok($o->load, "load() 6 - $db_type"); is($o5->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o5->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o5->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o5->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 6 (array value) - $db_type"); ok($o->delete, "delete() - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, 'alias_column() nonesuch'); $o2->forget; $o = MySQLiteObject->new(name => 'John'); ok($o->load, "load() forget 1 - $db_type"); $o->forget; $o2 = MySQLiteObject->new(name => 'John'); ok($o2->load, "load() forget 2 - $db_type"); ok($o ne $o2, "load() forget 3 - $db_type"); $o->meta->clear_object_cache; FORGET_ALL_SQLITE: { no warnings; is(scalar keys %MySQLiteObject::Objects_By_Id, 0, "clear_object_cache() 1 - $db_type"); is(scalar keys %MySQLiteObject::Objects_By_Key, 0, "clear_object_cache() 2 - $db_type"); is(scalar keys %MySQLiteObject::Objects_Keys, 0, "clear_object_cache() 3 - $db_type"); } # Cache expiration with primary key MySQLiteObject->meta->cached_objects_expire_in('5 seconds'); $o = MySQLiteObject->new(id => 99); $o->load or die $o->error; my $loaded = $MySQLiteObject::Objects_By_Id_Loaded{99}; is($MySQLiteObject::Objects_By_Id_Loaded{99}, $loaded, "cache_expires_in pk 1 - $db_type"); $o->load or die $o->error; is($MySQLiteObject::Objects_By_Id_Loaded{99}, $loaded, "cache_expires_in pk 2 - $db_type"); sleep(5); $o->load or die $o->error; ok($MySQLiteObject::Objects_By_Id_Loaded{99} != $loaded, "cache_expires_in pk 3 - $db_type"); # Cache expiration with unique key MySQLiteObject->meta->cached_objects_expire_in('5 seconds'); $o = MySQLiteObject->new(name => 'John'); $o->load or die $o->error; $loaded = $MySQLiteObject::Objects_By_Key_Loaded{'namex'}{'John'}; is($MySQLiteObject::Objects_By_Key_Loaded{'namex'}{'John'}, $loaded, "cache_expires_in uk 1 - $db_type"); $o->load or die $o->error; is($MySQLiteObject::Objects_By_Key_Loaded{'namex'}{'John'}, $loaded, "cache_expires_in uk 2 - $db_type"); sleep(5); $o->load or die $o->error; ok($MySQLiteObject::Objects_By_Key_Loaded{'namex'}{'John'} != $loaded, "cache_expires_in uk 3 - $db_type"); MySQLiteObject->remember_all; $loaded = $MySQLiteObject::Objects_By_Key_Loaded{'namex'}{'John'}; ok($loaded && $loaded ne $o, "remember_all - $db_type"); } BEGIN { # # Generic # GENERIC: { package MyCachedObject; our @ISA = qw(Rose::DB::Object::Cached); } # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_PG = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_private.rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_chkpass_test'); $dbh->do('CREATE SCHEMA rose_db_object_private'); } our $PG_HAS_CHKPASS = pg_has_chkpass(); $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id SERIAL PRIMARY KEY, @{[ $PG_HAS_CHKPASS ? 'password CHKPASS,' : '' ]} name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits BIT(5) NOT NULL DEFAULT B'00101', start DATE, save INT, nums INT[], last_modified TIMESTAMP NOT NULL DEFAULT 'now', date_created TIMESTAMP NOT NULL DEFAULT 'now', UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_private.rose_db_object_test ( id SERIAL PRIMARY KEY, @{[ $PG_HAS_CHKPASS ? 'password CHKPASS,' : '' ]} name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits BIT(5) NOT NULL DEFAULT B'00101', start DATE, save INT, nums INT[], last_modified TIMESTAMP NOT NULL DEFAULT 'now', date_created TIMESTAMP NOT NULL DEFAULT 'now', UNIQUE(name) ) EOF $dbh->disconnect; # Create test subclass package MyPgObject; our @ISA = qw(Rose::DB::Object::Cached); sub init_db { Rose::DB->new('pg') } MyPgObject->meta->table('rose_db_object_test'); MyPgObject->meta->columns ( 'name', id => { primary_key => 1 }, ($PG_HAS_CHKPASS ? (password => { type => 'chkpass' }) : ()), flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, nums => { type => 'array' }, bits => { type => 'bitfield', bits => 5, default => 101 }, last_modified => { type => 'timestamp', default => 'now' }, date_created => { type => 'timestamp', default => 'now' }, ); eval { MyPgObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MyPgObject->meta->add_unique_key('name'); MyPgObject->meta->alias_column(save => 'save_col'); MyPgObject->meta->initialize(replace_existing => 1); Test::More::ok(MyPgObject->meta->method_name_is_reserved('remember', 'MyPgObject'), 'reserved method: remember'); Test::More::ok(MyPgObject->meta->method_name_is_reserved('forget', 'MyPgObject'), 'reserved method: forget'); } # # MySQL # my $db_version; eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh() or die Rose::DB->error; $db_version = $db->database_version; }; if(!$@ && $dbh) { our $HAVE_MYSQL = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } # MySQL 5.0.3 or later has a completely stupid "native" BIT type my $bit_col = ($db_version >= 5_000_003) ? q(bits BIT(5) NOT NULL DEFAULT B'00101') : q(bits BIT(5) NOT NULL DEFAULT '00101'); $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, name VARCHAR(32) NOT NULL, flag TINYINT(1) NOT NULL, flag2 TINYINT(1), status VARCHAR(32) DEFAULT 'active', $bit_col, start DATE, save INT, last_modified TIMESTAMP NOT NULL, date_created DATETIME, UNIQUE(name) ) EOF $dbh->disconnect; # Create test subclass package MyMySQLObject; our @ISA = qw(Rose::DB::Object::Cached); sub init_db { Rose::DB->new('mysql') } MyMySQLObject->meta->allow_inline_column_values(1); MyMySQLObject->meta->table('rose_db_object_test'); MyMySQLObject->meta->columns ( 'name', id => { primary_key => 1 }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, bits => { type => 'bitfield', bits => 5, default => 101 }, last_modified => { type => 'timestamp' }, date_created => { type => 'datetime' }, ); eval { MyMySQLObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MyMySQLObject->meta->add_unique_key('name'); MyMySQLObject->meta->alias_column(save => 'save_col'); MyMySQLObject->meta->initialize(preserve_existing => 1); Test::More::ok(MyMySQLObject->meta->method_name_is_reserved('remember', 'MyMySQLObject'), 'reserved method: remember'); Test::More::ok(MyMySQLObject->meta->method_name_is_reserved('forget', 'MyMySQLObject'), 'reserved method: forget'); } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_INFORMIX = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits VARCHAR(5) DEFAULT '00101' NOT NULL, nums VARCHAR(255), start DATE, save INT, last_modified DATETIME YEAR TO FRACTION(5), date_created DATETIME YEAR TO FRACTION(5), UNIQUE(name) ) EOF $dbh->disconnect; # Create test subclass package MyInformixObject; our @ISA = qw(Rose::DB::Object::Cached); sub init_db { Rose::DB->new('informix') } MyInformixObject->meta->table('rose_db_object_test'); MyInformixObject->meta->columns ( 'name', id => { primary_key => 1 }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, nums => { type => 'array' }, bits => { type => 'bitfield', bits => 5, default => 101 }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); eval { MyInformixObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MyInformixObject->meta->add_unique_key('name'); MyInformixObject->meta->alias_column(save => 'save_col'); MyInformixObject->meta->initialize(preserve_existing => 1); Test::More::ok(MyInformixObject->meta->method_name_is_reserved('remember', 'MyInformixObject'), 'reserved method: remember'); Test::More::ok(MyInformixObject->meta->method_name_is_reserved('forget', 'MyInformixObject'), 'reserved method: forget'); } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_SQLITE = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INTEGER PRIMARY KEY AUTOINCREMENT, namex VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits VARCHAR(5) DEFAULT '00101' NOT NULL, nums VARCHAR(255), startx DATE, save INT, last_modified TIMESTAMP, date_created TIMESTAMP, UNIQUE(namex) ) EOF $dbh->disconnect; # Create test subclass package MySQLiteObject; our @ISA = qw(Rose::DB::Object::Cached); sub init_db { Rose::DB->new('sqlite') } MySQLiteObject->meta->table('rose_db_object_test'); MySQLiteObject->meta->columns ( namex => { alias => 'name' }, id => { primary_key => 1 }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, startx => { type => 'date', default => '12/24/1980', alias => 'start' }, 'save', nums => { type => 'array' }, bits => { type => 'bitfield', bits => 5, default => 101 }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); eval { MySQLiteObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MySQLiteObject->meta->add_unique_key('namex'); MySQLiteObject->meta->alias_column(save => 'save_col'); MySQLiteObject->meta->initialize(preserve_existing => 1); Test::More::ok(MySQLiteObject->meta->method_name_is_reserved('remember', 'MySQLiteObject'), 'reserved method: remember'); Test::More::ok(MySQLiteObject->meta->method_name_is_reserved('forget', 'MySQLiteObject'), 'reserved method: forget'); } } END { # Delete test table if($HAVE_PG) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_private.rose_db_object_test'); $dbh->do('DROP SCHEMA rose_db_object_private CASCADE'); $dbh->disconnect; } if($HAVE_MYSQL) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } if($HAVE_INFORMIX) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } if($HAVE_SQLITE) { # SQLite my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-changes-only-1.t000755 000765 000120 00000164035 12054157213 021224 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 494; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Util'); } Rose::DB::Object::Util->import(':all'); our($PG_HAS_CHKPASS, $HAVE_PG, $HAVE_MYSQL, $HAVE_INFORMIX, $HAVE_SQLITE); # # PostgreSQL # SKIP: foreach my $db_type (qw(pg pg_with_schema)) { skip("PostgreSQL tests", 226) unless($HAVE_PG); Rose::DB->default_type($db_type); TEST_HACK: { no warnings; *MyPgObject::init_db = sub { Rose::DB->new($db_type) }; } my $o = MyPgObject->new(name => 'John', k1 => 1, k2 => undef, k3 => 3); ok(ref $o && $o->isa('MyPgObject'), "new() 1 - $db_type"); $o->flag2('TRUE'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(7); if(rand >= 0.5) { ok($o->save, "save() 1 - $db_type"); } else { ok($o->insert, "insert() 1 - $db_type"); } is($o->meta->primary_key->sequence_names->[0], 'rose_db_object_test_id_seq', "pk sequence name - $db_type"); ok(is_in_db($o), "is_in_db - $db_type"); is($o->id, 1, "auto-generated primary key - $db_type"); ok($o->load, "load() 1 - $db_type"); $o->name('C' x 50); is($o->name, 'C' x 32, "varchar truncation - $db_type"); $o->name('John'); $o->code('A'); is($o->code, 'A ', "character padding - $db_type"); $o->code('C' x 50); is($o->code, 'C' x 6, "character truncation - $db_type"); my $ouk; ok($ouk = MyPgObject->new(k1 => 1, k2 => undef, k3 => 3)->load, "load() uk 1 - $db_type"); ok(!$ouk->not_found, "not_found() uk 1 - $db_type"); is($ouk->id, 1, "load() uk 2 - $db_type"); is($ouk->name, 'John', "load() uk 3 - $db_type"); ok($ouk->save, "save() uk 1 - $db_type"); my $o2 = MyPgObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyPgObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 7, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); $o2->set_status('foo'); is($o2->get_status, 'foo', "get_status() - $db_type"); $o2->set_status('active'); eval { $o2->set_status }; ok($@, "set_status() - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); my $clone = $o2->clone; ok($o2->start eq $clone->start, "clone() 1 - $db_type"); $clone->start->set(year => '1960'); ok($o2->start ne $clone->start, "clone() 2 - $db_type"); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); ok(!has_modified_columns($o2), "no modified columns after load() - $db_type"); $o2->name('John 2'); $o2->save(changes_only => 1); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $bo = MyPgObject->new(id => $o->id); $bo->load; $bo->flag(0); $bo->save; $bo = MyPgObject->new(id => $o->id); $bo->load; ok(!$bo->flag, "boolean check - $db_type"); $bo->flag(0); $bo->save; my $o3 = MyPgObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyPgObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->load, "load() 4 - $db_type"); SKIP: { if($PG_HAS_CHKPASS) { $o->{'password_encrypted'} = ':8R1Kf2nOS0bRE'; ok($o->password_is('xyzzy'), "chkpass() 1 - $db_type"); is($o->password, 'xyzzy', "chkpass() 2 - $db_type"); $o->password('foobar'); ok($o->password_is('foobar'), "chkpass() 3 - $db_type"); is($o->password, 'foobar', "chkpass() 4 - $db_type"); $o->code('C1'); #local $Rose::DB::Object::Debug = 1; ok($o->save, "save() 3 - $db_type"); $o = MyPgObject->new(id => $o->id)->load; $o->code('C2'); $o->save; $o = MyPgObject->new(id => $o->id)->load; ok($o->password_is('foobar'), "chkpass() 6 - $db_type"); } else { skip("chkpass tests", 6); } } my $o5 = MyPgObject->new(id => $o->id); ok($o5->load, "load() 5 - $db_type"); SKIP: { if($PG_HAS_CHKPASS) { ok($o5->password_is('foobar'), "chkpass() 7 - $db_type"); is($o5->password, 'foobar', "chkpass() 8 - $db_type"); } else { skip("chkpass tests", 2); } } $o5->nums([ 4, 5, 6 ]); ok($o5->save, "save() 4 - $db_type"); ok($o->load, "load() 6 - $db_type"); is($o5->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o5->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o5->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o5->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); ok($o->delete, "delete() - $db_type"); $o = MyPgObject->new(name => 'John', id => 9); $o->save_col(22); ok($o->save, "save() 4 - $db_type"); $o->save_col(50); ok($o->save, "save() 5 - $db_type"); $ouk = MyPgObject->new(save_col => 50); ok($ouk->load, "load() aliased unique key - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, "alias_column() nonesuch - $db_type"); # This is okay now #eval { $o->meta->alias_column(id => 'foo') }; #ok($@, "alias_column() primary key - $db_type"); $o = MyPgObject->new(id => 777); $o->meta->error_mode('fatal'); $o->dbh->{'PrintError'} = 0; eval { $o->load }; ok($@ && $o->not_found, "load() not found fatal - $db_type"); $o->id('abc'); eval { $o->load }; ok($@ && !$o->not_found, "load() fatal - $db_type"); eval { $o->save }; ok($@, "save() fatal - $db_type"); $o = MyPgObject->new(id => 9999); # no such id $o->meta->error_mode('fatal'); eval { $o->load() }; ok($@, "load() non-speculative implicit - $db_type"); ok(!$o->load(speculative => 1), "load() speculative explicit 1 - $db_type"); eval { $o->load(speculative => 0) }; ok($@, "load() non-speculative explicit 2 - $db_type"); $o->meta->default_load_speculative(1); ok(!$o->load(), "load() speculative implicit - $db_type"); ok(!$o->load(speculative => 1), "load() speculative explicit 2 - $db_type"); eval { $o->load(speculative => 0) }; ok($@, "load() non-speculative explicit 2 - $db_type"); # Reset for next trip through loop $o->meta->default_load_speculative(0); $o->meta->error_mode('return'); $o = MyPgObject->new(name => 'John', k1 => 1, k2 => undef, k3 => 3)->save; is($o->dur->months, 2, "interval months 1 - $db_type"); is($o->dur->days, 5, "interval days 1 - $db_type"); is($o->dur->seconds, 3, "interval seconds 1 - $db_type"); $o->dur(DateTime::Duration->new(years => 7, nanoseconds => 3000)); is($o->dur->in_units('years'), 7, "interval in_units years 1 - $db_type"); is($o->dur->in_units('months'), 84, "interval in_units months 1 - $db_type"); is($o->dur->nanoseconds, 3000, "interval nanoseconds 1 - $db_type"); is($o->dur->days, 0, "interval days 2 - $db_type"); is($o->dur->minutes, 0, "interval minutes 2 - $db_type"); is($o->dur->seconds, 0, "interval seconds 2 - $db_type"); $o->save; $o = MyPgObject->new(id => $o->id)->load; is($o->dur->in_units('years'), 7, "interval in_units years 2 - $db_type"); is($o->dur->in_units('months'), 84, "interval in_units months 2 - $db_type"); is($o->dur->nanoseconds, 3000, "interval nanoseconds 2 - $db_type"); is($o->dur->days, 0, "interval days 3 - $db_type"); is($o->dur->minutes, 0, "interval minutes 3 - $db_type"); is($o->dur->seconds, 0, "interval seconds 3 - $db_type"); is($o->epoch(format => '%Y-%m-%d %H:%M:%S'), '1999-11-30 21:30:00', "epoch 1 - $db_type"); $o->hiepoch('943997400.123456'); is($o->hiepoch(format => '%Y-%m-%d %H:%M:%S.%6N'), '1999-11-30 21:30:00.123456', "epoch hires 1 - $db_type"); $o->epoch('5/6/1980 12:34:56'); $o->save; $o = MyPgObject->new(id => $o->id)->load; is($o->epoch(format => '%Y-%m-%d %H:%M:%S'), '1980-05-06 12:34:56', "epoch 2 - $db_type"); is($o->hiepoch(format => '%Y-%m-%d %H:%M:%S.%6N'), '1999-11-30 21:30:00.123456', "epoch hires 2 - $db_type"); is($o->bint1, '9223372036854775800', "bigint 1 - $db_type"); is($o->bint2, '-9223372036854775800', "bigint 2 - $db_type"); is($o->bint3, '9223372036854775000', "bigint 3 - $db_type"); is($o->bint4, undef, "bigint 3.1 - $db_type"); $o->bint1($o->bint1 + 1); $o->save; $o = MyPgObject->new(id => $o->id)->load; is($o->bint1, '9223372036854775801', "bigint 4 - $db_type"); $o->bint3(5); eval { $o->bint3(7) }; ok($@, "bigint 5 - $db_type"); #local $Rose::DB::Object::Debug = 1; $o = MyPgObject2->new->save(changes_only => 1); $o = MyPgObject2->new(id => $o->id)->load; is($o->num, 123, "insert changes only 1 - $db_type"); is($o->flag, 2, "insert changes only 2 - $db_type"); $o = MyPgObject2->new(flag => 7)->save(changes_only => 1); $o = MyPgObject2->new(id => $o->id)->load; is($o->num, 123, "insert changes only 3 - $db_type"); is($o->flag, 7, "insert changes only 4 - $db_type"); #local $Rose::DB::Object::Debug = 1; $o = MyPgObject3->new->save; $o = MyPgObject3->new(id => $o->id)->load; is($o->num, 123, "insert changes only 5 - $db_type"); is($o->flag, 1, "insert changes only 6 - $db_type"); $o = MyPgObject2->new(flag => 7)->save(changes_only => 1); $o = MyPgObject2->new(id => $o->id)->load; is($o->num, 123, "insert changes only 7 - $db_type"); is($o->flag, 7, "insert changes only 8 - $db_type"); MyPgObject3->meta->allow_inline_column_values(1); $o = MyPgObject3->new(dt => 'now()')->save(changes_only => 1); $o = MyPgObject3->new(id => $o->id)->load; is($o->num, 123, "insert changes only 9 - $db_type"); is($o->flag, 1, "insert changes only 10 - $db_type"); } # # MySQL # SKIP: foreach my $db_type ('mysql') { skip("MySQL tests", 105) unless($HAVE_MYSQL); Rose::DB->default_type($db_type); my $o = MyMySQLObject->new(name => 'John', k1 => 1, k2 => undef, k3 => 3); ok(ref $o && $o->isa('MyMySQLObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(22); $o->bitz3('11'); if(rand >= 0.5) { ok($o->save, "save() 1 - $db_type"); } else { ok($o->insert, "insert() 1 - $db_type"); } ok($o->load, "load() 1 - $db_type"); my $ox = MyMySQLObject->new(id => $o->id)->load; is($ox->bitz2->to_Bin(), '00', "spot check bitfield 1 - $db_type"); is($ox->bitz3->to_Bin(), '0011', "spot check bitfield 2 - $db_type"); eval { $o->name('C' x 50) }; ok($@, "varchar overflow fatal - $db_type"); $o->name('John'); $o->code('A'); is($o->code, 'A ', "character padding - $db_type"); eval { $o->code('C' x 50) }; ok($@, "code overflow fatal - $db_type"); $o->code('C' x 6); is($o->enums, 'foo', "enum 1 - $db_type"); eval { $o->enums('blee') }; ok($@, "enum 2 - $db_type"); $o->enums('bar'); my $ouk; ok($ouk = MyMySQLObject->new(k1 => 1, k2 => undef, k3 => 3)->load, "load() uk 1 - $db_type"); ok(!$ouk->not_found, "not_found() uk 1 - $db_type"); is($ouk->id, 1, "load() uk 2 - $db_type"); is($ouk->name, 'John', "load() uk 3 - $db_type"); ok($ouk->save, "save() uk 1 - $db_type"); my $o2 = MyMySQLObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyMySQLObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); is($o2->bitz2->to_Bin, '00', "bitz2() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 22, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); $o2->set_status('foo'); is($o2->get_status, 'foo', 'get_status()'); $o2->set_status('active'); eval { $o2->set_status }; ok($@, 'set_status()'); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); is($o2->bitz2->to_Bin, '00', "load() verify 10 (bitfield value) - $db_type"); is($o2->bitz3->to_Bin, '0011', "load() verify 11 (bitfield value) - $db_type"); my $clone = $o2->clone; ok($o2->start eq $clone->start, "clone() 1 - $db_type"); $clone->start->set(year => '1960'); ok($o2->start ne $clone->start, "clone() 2 - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyMySQLObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyMySQLObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); $o->nums([ 4, 5, 6 ]); ok($o->save, "save() 3 - $db_type"); ok($o->load, "load() 4 - $db_type"); is($o->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); ok($o->delete, "delete() - $db_type"); $o = MyMySQLObject->new(name => 'John', id => 9); $o->save_col(22); ok($o->save, "save() 4 - $db_type"); $o->save_col(50); ok($o->save, "save() 5 - $db_type"); $ouk = MyMySQLObject->new(save_col => 50); ok($ouk->load, "load() aliased unique key - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, "alias_column() nonesuch - $db_type"); # This is okay now #eval { $o->meta->alias_column(id => 'foo') }; #ok($@, "alias_column() primary key - $db_type"); $o = MyMySQLObject->new(id => 777); $o->meta->error_mode('fatal'); $o->dbh->{'PrintError'} = 0; eval { $o->load }; ok($@ && $o->not_found, "load() not found fatal - $db_type"); my $old_table = $o->meta->table; $o->meta->table('nonesuch'); eval { $o->load }; ok($@ && !$o->not_found, "load() fatal - $db_type"); eval { $o->save }; ok($@, "save() fatal - $db_type"); $o->meta->table($old_table); $o->meta->error_mode('return'); $o = MyMPKMySQLObject->new(name => 'John'); ok($o->save, "save() 1 multi-value primary key with generated values - $db_type"); is($o->k1, 1, "save() verify 1 multi-value primary key with generated values - $db_type"); is($o->k2, 2, "save() verify 2 multi-value primary key with generated values - $db_type"); $o = MyMPKMySQLObject->new(name => 'Alex'); ok($o->save, "save() 2 multi-value primary key with generated values - $db_type"); is($o->k1, 3, "save() verify 3 multi-value primary key with generated values - $db_type"); is($o->k2, 4, "save() verify 4 multi-value primary key with generated values - $db_type"); is($ox->bitz3->to_Bin(), '0011', "spot check bitfield 3 - $db_type"); $ox->bitz3->Bit_On(3); set_column_value_modified($ox, 'bitz3'); is($ox->bitz3->to_Bin(), '1011', "spot check bitfield 4 - $db_type"); $ox->save(insert => 1); $ox = MyMySQLObject->new(id => $ox->id)->load; is($ox->bitz3->to_Bin(), '1011', "spot check bitfield 5 - $db_type"); $ox->bitz3->Bit_On(2); set_column_value_modified($ox, 'bitz3'); $ox->save; $ox = MyMySQLObject->new(id => $ox->id)->load; is($ox->bitz3->to_Bin(), '1111', "spot check bitfield 6 - $db_type"); $o = MyMySQLObject->new(id => 9999); # no such id $o->meta->error_mode('fatal'); eval { $o->load() }; ok($@, "load() non-speculative implicit - $db_type"); ok(!$o->load(speculative => 1), "load() speculative explicit 1 - $db_type"); eval { $o->load(speculative => 0) }; ok($@, "load() non-speculative explicit 2 - $db_type"); $o->meta->default_load_speculative(1); ok(!$o->load(), "load() speculative implicit - $db_type"); ok(!$o->load(speculative => 1), "load() speculative explicit 2 - $db_type"); eval { $o->load(speculative => 0) }; ok($@, "load() non-speculative explicit 2 - $db_type"); $o->meta->default_load_speculative(0); $o = MyMySQLObject->new(id => 1)->load; is($o->dur->months, 2, "interval months 1 - $db_type"); is($o->dur->days, 5, "interval days 1 - $db_type"); is($o->dur->seconds, 3, "interval seconds 1 - $db_type"); $o->dur(DateTime::Duration->new(years => 7, nanoseconds => 3000)); is($o->dur->in_units('years'), 7, "interval in_units years 1 - $db_type"); is($o->dur->in_units('months'), 84, "interval in_units months 1 - $db_type"); is($o->dur->nanoseconds, 3000, "interval nanoseconds 1 - $db_type"); is($o->dur->days, 0, "interval days 2 - $db_type"); is($o->dur->minutes, 0, "interval minutes 2 - $db_type"); is($o->dur->seconds, 0, "interval seconds 2 - $db_type"); $o->save; $o = MyMySQLObject->new(id => $o->id)->load; is($o->dur->in_units('years'), 7, "interval in_units years 2 - $db_type"); is($o->dur->in_units('months'), 84, "interval in_units months 2 - $db_type"); is($o->dur->nanoseconds, 3000, "interval nanoseconds 2 - $db_type"); is($o->dur->days, 0, "interval days 3 - $db_type"); is($o->dur->minutes, 0, "interval minutes 3 - $db_type"); is($o->dur->seconds, 0, "interval seconds 3 - $db_type"); is($o->meta->column('dur')->scale, 6, "interval scale - $db_type"); is($o->epoch(format => '%Y-%m-%d %H:%M:%S'), '1999-11-30 21:30:00', "epoch 1 - $db_type"); $o->hiepoch('943997400.123456'); is($o->hiepoch(format => '%Y-%m-%d %H:%M:%S.%6N'), '1999-11-30 21:30:00.123456', "epoch hires 1 - $db_type"); $o->epoch('5/6/1980 12:34:56'); $o->save; $o = MyMySQLObject->new(id => $o->id)->load; is($o->epoch(format => '%Y-%m-%d %H:%M:%S'), '1980-05-06 12:34:56', "epoch 2 - $db_type"); is($o->hiepoch(format => '%Y-%m-%d %H:%M:%S.%6N'), '1999-11-30 21:30:00.123456', "epoch hires 2 - $db_type"); #local $Rose::DB::Object::Debug = 1; $o = MyMySQLObject3->new->save; $o = MyMySQLObject3->new(id => $o->id)->load; is($o->num, 123, "insert changes only 5 - $db_type"); is($o->flag, 1, "insert changes only 6 - $db_type"); } # # Informix # SKIP: foreach my $db_type ('informix') { skip("Informix tests", 73) unless($HAVE_INFORMIX); Rose::DB->default_type($db_type); my $o = MyInformixObject->new(name => 'John', id => 1, k1 => 1, k2 => undef, k3 => 3); ok(ref $o && $o->isa('MyInformixObject'), "new() 1 - $db_type"); $o->meta->allow_inline_column_values(1); $o->flag2('true'); $o->date_created('current year to fraction(5)'); $o->last_modified($o->date_created); $o->save_col(22); if(rand >= 0.5) { ok($o->save, "save() 1 - $db_type"); } else { ok($o->insert, "insert() 1 - $db_type"); } ok($o->load, "load() 1 - $db_type"); $o->name('C' x 50); is($o->name, 'C' x 32, "varchar truncation - $db_type"); $o->name('John'); $o->code('A'); is($o->code, 'A ', "character padding - $db_type"); $o->code('C' x 50); is($o->code, 'C' x 6, "character truncation - $db_type"); my $ouk; ok($ouk = MyInformixObject->new(k1 => 1, k2 => undef, k3 => 3)->load, "load() uk 1 - $db_type"); ok(!$ouk->not_found, "not_found() uk 1 - $db_type"); is($ouk->id, 1, "load() uk 2 - $db_type"); is($ouk->name, 'John', "load() uk 3 - $db_type"); ok($ouk->save, "save() uk 1 - $db_type"); my $o2 = MyInformixObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyInformixObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 22, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); $o2->set_status('foo'); is($o2->get_status, 'foo', 'get_status()'); $o2->set_status('active'); eval { $o2->set_status }; ok($@, 'set_status()'); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); my $clone = $o2->clone; ok($o2->start eq $clone->start, "clone() 1 - $db_type"); $clone->start->set(year => '1960'); ok($o2->start ne $clone->start, "clone() 2 - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('current year to second'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyInformixObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyInformixObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); $o->nums([ 4, 5, 6 ]); $o->names([ qw(a b 3.1) ]); ok($o->save, "save() 3 - $db_type"); ok($o->load, "load() 4 - $db_type"); is($o->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o->nums->[2], 6, "load() verify 12 (array value) - $db_type"); $o->nums(7, 8, 9); my @a = $o->nums; is($a[0], 7, "load() verify 13 (array value) - $db_type"); is($a[1], 8, "load() verify 14 (array value) - $db_type"); is($a[2], 9, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); is($o->names->[0], 'a', "load() verify 10 (set value) - $db_type"); is($o->names->[1], 'b', "load() verify 11 (set value) - $db_type"); is($o->names->[2], '3.1', "load() verify 12 (set value) - $db_type"); $o->names('c', 'd', '4.2'); @a = $o->names; is($a[0], 'c', "load() verify 13 (set value) - $db_type"); is($a[1], 'd', "load() verify 14 (set value) - $db_type"); is($a[2], '4.2', "load() verify 15 (set value) - $db_type"); is(@a, 3, "load() verify 16 (set value) - $db_type"); ok($o->delete, "delete() - $db_type"); $o = MyInformixObject->new(name => 'John', id => 9); $o->flag2('true'); $o->date_created('current year to fraction(5)'); $o->last_modified($o->date_created); $o->save_col(22); ok($o->save, "save() 4 - $db_type"); $o->save_col(50); ok($o->save, "save() 5 - $db_type"); $ouk = MyInformixObject->new(save_col => 50); ok($ouk->load, "load() aliased unique key - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, "alias_column() nonesuch - $db_type"); # This is okay now #eval { $o->meta->alias_column(id => 'foo') }; #ok($@, "alias_column() primary key - $db_type"); $o = MyInformixObject->new(id => 777); $o->meta->error_mode('fatal'); $o->dbh->{'PrintError'} = 0; eval { $o->load }; ok($@ && $o->not_found, "load() not found fatal - $db_type"); $o->id('abc'); eval { $o->load }; ok($@ && !$o->not_found, "load() fatal - $db_type"); eval { $o->save }; ok($@, "save() fatal - $db_type"); #$o->meta->error_mode('return'); $o = MyInformixObject->new(id => 9999); # no such id $o->meta->error_mode('fatal'); eval { $o->load() }; ok($@, "load() non-speculative implicit - $db_type"); ok(!$o->load(speculative => 1), "load() speculative explicit 1 - $db_type"); eval { $o->load(speculative => 0) }; ok($@, "load() non-speculative explicit 2 - $db_type"); $o->meta->default_load_speculative(1); ok(!$o->load(), "load() speculative implicit - $db_type"); ok(!$o->load(speculative => 1), "load() speculative explicit 2 - $db_type"); eval { $o->load(speculative => 0) }; ok($@, "load() non-speculative explicit 2 - $db_type"); } # # SQLite # SKIP: foreach my $db_type ('sqlite') { skip("SQLite tests", 88) unless($HAVE_SQLITE); Rose::DB->default_type($db_type); my $o = MySQLiteObject->new; $o->k1(0); ok(has_modified_columns($o), "has_modified_columns() zero - $db_type"); $o->k1(undef); ok(has_modified_columns($o), "has_modified_columns() undef - $db_type"); $o = MySQLiteObject->new(name => 'John', k1 => 0, k2 => undef, k3 => 3); ok(get_column_value_modified($o, 'k1'), "zero modification - $db_type"); $o->k1(1); ok(ref $o && $o->isa('MySQLiteObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(22); if(rand >= 0.5) { ok($o->save, "save() 1 - $db_type"); } else { ok($o->insert, "insert() 1 - $db_type"); } ok($o->load, "load() 1 - $db_type"); $o->name('C' x 50); is($o->name, 'C' x 32, "varchar truncation - $db_type"); $o->name('John'); $o->code('A'); is($o->code, 'A ', "character padding - $db_type"); $o->code('C' x 50); is($o->code, 'C' x 6, "character truncation - $db_type"); my $ouk; ok($ouk = MySQLiteObject->new(k1 => 1, k2 => undef, k3 => 3)->load, "load() uk 1 - $db_type"); ok(!$ouk->not_found, "not_found() uk 1 - $db_type"); is($ouk->id->[0], 1, "load() uk 2 - $db_type"); is($ouk->name, 'John', "load() uk 3 - $db_type"); ok($ouk->save, "save() uk 1 - $db_type"); my $o2 = MySQLiteObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MySQLiteObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 22, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); $o2->set_status('foo'); is($o2->get_status, 'foo', 'get_status()'); $o2->set_status('active'); eval { $o2->set_status }; ok($@, 'set_status()'); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); my $clone = $o2->clone; ok($o2->start eq $clone->start, "clone() 1 - $db_type"); $clone->start->set(year => '1960'); ok($o2->start ne $clone->start, "clone() 2 - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MySQLiteObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MySQLiteObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); $o->nums([ 4, 5, 6 ]); ok($o->save, "save() 3 - $db_type"); ok($o->load, "load() 4 - $db_type"); is($o->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); ok($o->delete, "delete() - $db_type"); $o = MySQLiteObject->new(name => 'John', id => 9); $o->save_col(22); ok($o->save, "save() 4 - $db_type"); $o->save_col(50); ok($o->save, "save() 5 - $db_type"); $ouk = MySQLiteObject->new(save_col => 50); ok($ouk->load, "load() aliased unique key - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, "alias_column() nonesuch - $db_type"); # This is okay now #eval { $o->meta->alias_column(id => 'foo') }; #ok($@, "alias_column() primary key - $db_type"); $o = MySQLiteObject->new(id => 777); $o->meta->error_mode('fatal'); $o->dbh->{'PrintError'} = 0; eval { $o->load }; ok($@ && $o->not_found, "load() not found fatal - $db_type"); my $old_table = $o->meta->table; $o->meta->table('nonesuch'); eval { $o->load }; ok($@ && !$o->not_found, "load() fatal - $db_type"); eval { $o->save }; ok($@, "save() fatal - $db_type"); $o->meta->table($old_table); $o->meta->error_mode('return'); $o = MyMPKSQLiteObject->new(name => 'John'); ok($o->save, "save() 1 multi-value primary key with generated values - $db_type"); is($o->k1, 1, "save() verify 1 multi-value primary key with generated values - $db_type"); is($o->k2, 2, "save() verify 2 multi-value primary key with generated values - $db_type"); $o = MyMPKSQLiteObject->new(name => 'Alex'); ok($o->save, "save() 2 multi-value primary key with generated values - $db_type"); is($o->k1, 3, "save() verify 3 multi-value primary key with generated values - $db_type"); is($o->k2, 4, "save() verify 4 multi-value primary key with generated values - $db_type"); $o = MySQLiteObject->new(id => 9999); # no such id $o->meta->error_mode('fatal'); eval { $o->load() }; ok($@, "load() non-speculative implicit - $db_type"); ok(!$o->load(speculative => 1), "load() speculative explicit 1 - $db_type"); eval { $o->load(speculative => 0) }; ok($@, "load() non-speculative explicit 2 - $db_type"); $o->meta->default_load_speculative(1); ok(!$o->load(), "load() speculative implicit - $db_type"); ok(!$o->load(speculative => 1), "load() speculative explicit 2 - $db_type"); eval { $o->load(speculative => 0) }; ok($@, "load() non-speculative explicit 2 - $db_type"); #local $Rose::DB::Object::Debug = 1; $o = MySQLiteObject3->new->save; $o = MySQLiteObject3->new(id => $o->id)->load; is($o->num, 123, "insert changes only 1 - $db_type"); is($o->flag, 2, "insert changes only 2 - $db_type"); $o = MySQLiteObject3->new(flag => 7)->save; $o = MySQLiteObject3->new(id => $o->id)->load; is($o->num, 123, "insert changes only 1 - $db_type"); is($o->flag, 7, "insert changes only 2 - $db_type"); $o->num(123); QUIET: { local $Rose::DB::Object::Debug = 1; ok($o->save(changes_only => 1), "noop update smart 1 - $db_type"); } $o->num(undef); $o->save; $o->num(0); ok(has_modified_columns($o), "zero mod 1 - $db_type"); $o->save(changes_only => 1); $o->num(0); ok(!has_modified_columns($o), "zero mod 2 - $db_type"); $o->save(changes_only => 1); $o->num(undef); ok(has_modified_columns($o), "undef mod - $db_type"); $o->save(changes_only => 1); $o->load; $o->num(''); ok(has_modified_columns($o), "empty string mod 1 - $db_type"); $o->save(changes_only => 1); $o->load; is($o->num, '', "empty string mod 2 - $db_type"); $o = MySQLiteObject4->new(id => 1)->save; $o = MySQLiteObject4->new(id => 1)->load; ok($o->save, "noop update pk only 1 - $db_type"); $o->meta->default_insert_changes_only(0); $o->meta->default_update_changes_only(0); $o = MySQLiteObject4->new(id => 2)->save; $o = MySQLiteObject4->new(id => 2)->load; ok($o->save, "noop update pk only 2 - $db_type"); } BEGIN { # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_PG = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_test2'); $dbh->do('DROP TABLE rose_db_object_test3'); $dbh->do('DROP TABLE rose_db_object_private.rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_private.rose_db_object_test2'); $dbh->do('DROP TABLE rose_db_object_private.rose_db_object_test3'); $dbh->do('DROP TABLE rose_db_object_chkpass_test'); $dbh->do('CREATE SCHEMA rose_db_object_private'); } our $PG_HAS_CHKPASS = pg_has_chkpass(); $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, k1 INT, k2 INT, k3 INT, @{[ $PG_HAS_CHKPASS ? 'passwd CHKPASS,' : '' ]} name VARCHAR(32) NOT NULL, code CHAR(6), flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bitz BIT(5) NOT NULL DEFAULT B'00101', decs DECIMAL(10,2), start DATE, save INT, nums INT[], dur INTERVAL(6) DEFAULT '2 months 5 days 3 seconds', epoch INT DEFAULT 943997400, hiepoch DECIMAL(16,6), bint1 BIGINT DEFAULT 9223372036854775800, bint2 BIGINT DEFAULT -9223372036854775800, bint3 BIGINT, bint4 BIGINT, last_modified TIMESTAMP, date_created TIMESTAMP, UNIQUE(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_private.rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, k1 INT, k2 INT, k3 INT, @{[ $PG_HAS_CHKPASS ? 'passwd CHKPASS,' : '' ]} name VARCHAR(32) NOT NULL, code CHAR(6), flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bitz BIT(5) NOT NULL DEFAULT B'00101', decs DECIMAL(10,2), start DATE, save INT, nums INT[], dur INTERVAL(6) DEFAULT '2 months 5 days 3 seconds', epoch INT DEFAULT 943997400, hiepoch DECIMAL(16,6), bint1 BIGINT DEFAULT 9223372036854775800, bint2 BIGINT DEFAULT -9223372036854775800, bint3 BIGINT, bint4 BIGINT, last_modified TIMESTAMP, date_created TIMESTAMP, UNIQUE(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test2 ( id SERIAL PRIMARY KEY, num INT DEFAULT 123, flag INT DEFAULT 1, f2 INT ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_private.rose_db_object_test2 ( id SERIAL PRIMARY KEY, num INT DEFAULT 123, flag INT DEFAULT 1, f2 INT ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test3 ( id SERIAL PRIMARY KEY, num INT DEFAULT 123, flag INT DEFAULT 1, dt TIMESTAMP ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_private.rose_db_object_test3 ( id SERIAL PRIMARY KEY, num INT DEFAULT 123, flag INT DEFAULT 1, dt TIMESTAMP ) EOF $dbh->disconnect; # Create test subclass package MyPgObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } MyPgObject->meta->default_update_changes_only(1); MyPgObject->meta->table('rose_db_object_test'); MyPgObject->meta->columns ( name => { type => 'varchar', length => 32, overflow => 'truncate' }, code => { type => 'char', length => 6, overflow => 'truncate' }, id => { primary_key => 1, not_null => 1 }, k1 => { type => 'int' }, k2 => { type => 'int', lazy => 1 }, k3 => { type => 'int' }, ($PG_HAS_CHKPASS ? (passwd => { type => 'chkpass', alias => 'password' }) : ()), flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active', add_methods => [ qw(get set) ] }, start => { type => 'date', default => '12/24/1980', lazy => 1 }, save => { type => 'scalar' }, nums => { type => 'array' }, bitz => { type => 'bitfield', bits => 5, default => 101, alias => 'bits' }, decs => { type => 'decimal', precision => 10, scale => 2 }, dur => { type => 'interval', scale => 6, default => '2 months 5 days 3 seconds' }, epoch => { type => 'epoch', default => '11/30/1999 9:30pm' }, hiepoch => { type => 'epoch hires', default => '1144004926.123456' }, bint1 => { type => 'bigint', default => '9223372036854775800' }, bint2 => { type => 'bigint', default => '-9223372036854775800' }, bint3 => { type => 'bigint', with_init => 1, check_in => [ '9223372036854775000', 5 ] }, bint4 => { type => 'bigint', with_init => 1 }, #last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); sub init_bint4 { undef } MyPgObject->meta->add_unique_key('save'); MyPgObject->meta->add_unique_key([ qw(k1 k2 k3) ]); MyPgObject->meta->add_columns( Rose::DB::Object::Metadata::Column::Timestamp->new( name => 'last_modified')); eval { MyPgObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MyPgObject->meta->alias_column(save => 'save_col'); eval { MyPgObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() no override'); MyPgObject->meta->initialize(preserve_existing => 1); Test::More::is(MyPgObject->meta->column('id')->is_primary_key_member, 1, 'is_primary_key_member - pg'); Test::More::is(MyPgObject->meta->column('id')->primary_key_position, 1, 'primary_key_position 1 - pg'); Test::More::ok(!defined MyPgObject->meta->column('k1')->primary_key_position, 'primary_key_position 2 - pg'); MyPgObject->meta->column('k1')->primary_key_position(7); Test::More::ok(!defined MyPgObject->meta->column('k1')->primary_key_position, 'primary_key_position 3 - pg'); sub init_bint3 { '9223372036854775000' } package MyPgObject2; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } MyPgObject2->meta->setup ( table => 'rose_db_object_test2', columns => [ id => { type => 'serial', primary_key => 1 }, num => { type => 'int' }, # default is 123 flag => { type => 'int', default => 2 }, f2 => { type => 'int' }, ], ); package MyPgObject3; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } MyPgObject3->meta->setup ( table => 'rose_db_object_test3', columns => [ id => { type => 'serial', primary_key => 1 }, num => { type => 'int' }, # default is 123 flag => { type => 'int' }, # default is 1 dt => { type => 'timestamp' }, ], default_insert_changes_only => 1, ); } # # MySQL # my $db_version; eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh() or die Rose::DB->error; $db_version = $db->database_version; }; if(!$@ && $dbh) { our $HAVE_MYSQL = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_test2'); $dbh->do('DROP TABLE rose_db_object_test3'); } # MySQL 5.0.3 or later has a completely stupid "native" BIT type my $bit_col1 = ($db_version >= 5_000_003) ? q(bitz BIT(5) NOT NULL DEFAULT B'00101') : q(bitz BIT(5) NOT NULL DEFAULT '00101'); my $bit_col2 = ($db_version >= 5_000_003) ? q(bitz2 BIT(2) NOT NULL DEFAULT B'00') : q(bitz2 BIT(2) NOT NULL DEFAULT '0'); $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, k1 INT, k2 INT, k3 INT, name VARCHAR(32) NOT NULL, code CHAR(6), flag TINYINT(1) NOT NULL, flag2 TINYINT(1), status VARCHAR(32) DEFAULT 'active', $bit_col1, $bit_col2, bitz3 BIT(4), decs FLOAT(10,2), nums VARCHAR(255), start DATE, save INT, enums ENUM('foo', 'bar', 'baz') DEFAULT 'foo', ndate DATE NOT NULL DEFAULT '0000-00-00', dur VARCHAR(255) DEFAULT '2 months 5 days 3 seconds', epoch INT DEFAULT 943997400, hiepoch DECIMAL(16,6), last_modified TIMESTAMP, date_created TIMESTAMP, UNIQUE(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test2 ( k1 INT NOT NULL, k2 INT NOT NULL, name VARCHAR(32), UNIQUE(k1, k2) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test3 ( id INT AUTO_INCREMENT PRIMARY KEY, num INT DEFAULT 123, flag INT DEFAULT 1 ) EOF $dbh->disconnect; # Create test subclass package MyMySQLObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } MyMySQLObject->meta->allow_inline_column_values(1); MyMySQLObject->meta->default_update_changes_only(1); MyMySQLObject->meta->table('rose_db_object_test'); MyMySQLObject->meta->columns ( name => { type => 'varchar', length => 32 }, code => { type => 'char', length => 6 }, id => { primary_key => 1, not_null => 1 }, k1 => { type => 'int' }, k2 => { type => 'int', lazy => 1 }, k3 => { type => 'int' }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active', methods => [ qw(get_set get set) ] }, start => { type => 'date', default => '12/24/1980', lazy => 1 }, ndate => { type => 'date', not_null => 1, default => '0000-00-00' }, save => { type => 'scalar' }, nums => { type => 'array' }, enums => { type => 'enum', values => [ qw(foo bar baz) ], default => 'foo' }, bitz => { type => 'bitfield', bits => 5, default => 101, alias => 'bits' }, bitz2 => { type => 'bits', bits => 2, default => '0' }, bitz3 => { type => 'bits', bits => 4 }, decs => { type => 'decimal', precision => 10, scale => 2 }, dur => { type => 'interval', scale => 6, default => '2 months 5 days 3 seconds' }, epoch => { type => 'epoch', default => '11/30/1999 9:30pm' }, hiepoch => { type => 'epoch hires', default => '1144004926.123456' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); eval { MyMySQLObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MyMySQLObject->meta->alias_column(save => 'save_col'); eval { MyMySQLObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() no override'); MyMySQLObject->meta->add_unique_key('save'); MyMySQLObject->meta->add_unique_key([ qw(k1 k2 k3) ]); MyMySQLObject->meta->initialize(preserve_existing => 1); Test::More::is(MyMySQLObject->meta->column('id')->is_primary_key_member, 1, 'is_primary_key_member - mysql'); Test::More::is(MyMySQLObject->meta->column('id')->primary_key_position, 1, 'primary_key_position 1 - mysql'); Test::More::ok(!defined MyMySQLObject->meta->column('k1')->primary_key_position, 'primary_key_position 2 - mysql'); MyMySQLObject->meta->column('k1')->primary_key_position(7); Test::More::ok(!defined MyMySQLObject->meta->column('k1')->primary_key_position, 'primary_key_position 3 - mysql'); package MyMPKMySQLObject; use Rose::DB::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } MyMPKMySQLObject->meta->default_update_changes_only(1); MyMPKMySQLObject->meta->table('rose_db_object_test2'); MyMPKMySQLObject->meta->columns ( k1 => { type => 'int', not_null => 1 }, k2 => { type => 'int', not_null => 1 }, name => { type => 'varchar', length => 32 }, ); MyMPKMySQLObject->meta->primary_key_columns('k1', 'k2'); my $i = 1; MyMPKMySQLObject->meta->setup ( primary_key_generator => sub { my($meta, $db) = @_; my $k1 = $i++; my $k2 = $i++; return $k1, $k2; }, ); package MyMySQLObject3; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } MyMySQLObject3->meta->setup ( table => 'rose_db_object_test3', columns => [ id => { type => 'serial', primary_key => 1 }, num => { type => 'int' }, # default is 123 flag => { type => 'int' }, # default is 1 ], default_insert_changes_only => 1, ); } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_INFORMIX = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, k1 INT, k2 INT, k3 INT, name VARCHAR(32) NOT NULL, code CHAR(6), flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bitz VARCHAR(5) DEFAULT '00101' NOT NULL, decs DECIMAL(10,2), nums VARCHAR(255), start DATE, save INT, names SET(VARCHAR(64) NOT NULL), last_modified DATETIME YEAR TO FRACTION(5), date_created DATETIME YEAR TO FRACTION(5) ) EOF $dbh->disconnect; # Create test subclass package MyInformixObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('informix') } MyInformixObject->meta->allow_inline_column_values(1); MyInformixObject->meta->default_update_changes_only(1); MyInformixObject->meta->table('rose_db_object_test'); MyInformixObject->meta->columns ( name => { type => 'varchar', length => 32, overflow => 'truncate' }, code => { type => 'char', length => 6, overflow => 'truncate' }, id => { type => 'serial', primary_key => 1, not_null => 1 }, k1 => { type => 'int' }, k2 => { type => 'int', lazy => 1 }, k3 => { type => 'int' }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active', add_methods => [ qw(get set) ] }, start => { type => 'date', default => '12/24/1980', lazy => 1 }, save => { type => 'scalar' }, nums => { type => 'array' }, bitz => { type => 'bitfield', bits => 5, default => 101, alias => 'bits' }, decs => { type => 'decimal', precision => 10, scale => 2 }, names => { type => 'set' }, last_modified => { type => 'timestamp' }, date_created => { type => 'datetime year to fraction(5)' }, ); eval { MyInformixObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MyInformixObject->meta->prepare_options({ix_CursorWithHold => 1}); MyInformixObject->meta->alias_column(save => 'save_col'); eval { MyInformixObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() no override'); MyInformixObject->meta->add_unique_key('save'); MyInformixObject->meta->add_unique_key([ qw(k1 k2 k3) ]); MyInformixObject->meta->initialize(preserve_existing => 1); Test::More::is(MyInformixObject->meta->column('id')->is_primary_key_member, 1, 'is_primary_key_member - informix'); Test::More::is(MyInformixObject->meta->column('id')->primary_key_position, 1, 'primary_key_position 1 - informix'); Test::More::ok(!defined MyInformixObject->meta->column('k1')->primary_key_position, 'primary_key_position 2 - informix'); MyInformixObject->meta->column('k1')->primary_key_position(7); Test::More::ok(!defined MyInformixObject->meta->column('k1')->primary_key_position, 'primary_key_position 3 - informix'); } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_SQLITE = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_test2'); $dbh->do('DROP TABLE rose_db_object_test3'); $dbh->do('DROP TABLE rose_db_object_test4'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INTEGER PRIMARY KEY AUTOINCREMENT, k1 INT, k2 INT, k3 INT, name VARCHAR(32) NOT NULL, code CHAR(6), flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bitz VARCHAR(5) DEFAULT '00101' NOT NULL, decs DECIMAL(10,2), start DATE, save INT, nums VARCHAR(255), nonmod VARCHAR(255) DEFAULT 'defmod', last_modified TIMESTAMP, date_created TIMESTAMP, UNIQUE(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test2 ( k1 INT NOT NULL, k2 INT NOT NULL, name VARCHAR(32), UNIQUE(k1, k2) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test3 ( id INTEGER PRIMARY KEY AUTOINCREMENT, num INT DEFAULT 123, flag INT DEFAULT 1 ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test4 ( id INTEGER PRIMARY KEY ) EOF $dbh->disconnect; # Create test subclass package MySQLiteObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MySQLiteObject->meta->default_update_changes_only(1); MySQLiteObject->meta->table('rose_db_object_test'); MySQLiteObject->meta->columns ( name => { type => 'varchar', length => 32, overflow => 'truncate' }, code => { type => 'char', length => 6, overflow => 'truncate' }, id => { primary_key => 1, not_null => 1 }, k1 => { type => 'int' }, k2 => { type => 'int', lazy => 1 }, k3 => { type => 'int' }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active', add_methods => [ qw(get set) ] }, start => { type => 'date', default => '12/24/1980', lazy => 1 }, save => { type => 'scalar' }, nums => { type => 'array' }, nonmod => { type => 'varchar', length => 255 }, bitz => { type => 'bitfield', bits => 5, default => 101, alias => 'bits' }, decs => { type => 'decimal', precision => 10, scale => 2 }, #last_modified => { type => 'timestamp' }, date_created => { type => 'scalar' }, ); MySQLiteObject->meta->replace_column(date_created => { type => 'timestamp' }); MySQLiteObject->meta->add_unique_key('save'); MySQLiteObject->meta->add_unique_key([ qw(k1 k2 k3) ]); MySQLiteObject->meta->add_columns( Rose::DB::Object::Metadata::Column::Timestamp->new( name => 'last_modified')); MySQLiteObject->meta->column('id')->add_trigger(inflate => sub { defined $_[1] ? [ $_[1] ] : undef }); MySQLiteObject->meta->column('id')->add_trigger(deflate => sub { ref $_[1] ? @{$_[1]} : $_[1] }); my $pre_inited = 0; MySQLiteObject->meta->pre_init_hook(sub { $pre_inited++ }); eval { MySQLiteObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); Test::More::is($pre_inited, 1, 'meta->pre_init_hook()'); MySQLiteObject->meta->alias_column(save => 'save_col'); eval { MySQLiteObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() no override'); MySQLiteObject->meta->initialize(preserve_existing => 1); Test::More::is(MySQLiteObject->meta->column('id')->is_primary_key_member, 1, 'is_primary_key_member - sqlite'); Test::More::is(MySQLiteObject->meta->column('id')->primary_key_position, 1, 'primary_key_position 1 - sqlite'); Test::More::ok(!defined MySQLiteObject->meta->column('k1')->primary_key_position, 'primary_key_position 2 - sqlite'); MySQLiteObject->meta->column('k1')->primary_key_position(7); Test::More::ok(!defined MySQLiteObject->meta->column('k1')->primary_key_position, 'primary_key_position 3 - sqlite'); package MyMPKSQLiteObject; use Rose::DB::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MyMPKSQLiteObject->meta->default_update_changes_only(1); MyMPKSQLiteObject->meta->table('rose_db_object_test2'); MyMPKSQLiteObject->meta->columns ( k1 => { type => 'int', not_null => 1 }, k2 => { type => 'int', not_null => 1 }, name => { type => 'varchar', length => 32 }, ); MyMPKSQLiteObject->meta->primary_key_columns('k1', 'k2'); MyMPKSQLiteObject->meta->initialize; my $i = 1; MyMPKSQLiteObject->meta->primary_key_generator(sub { my($meta, $db) = @_; my $k1 = $i++; my $k2 = $i++; return $k1, $k2; }); package MySQLiteObject3; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MySQLiteObject3->meta->setup ( table => 'rose_db_object_test3', columns => [ id => { type => 'serial', primary_key => 1 }, num => { type => 'int', smart_modification => 1 }, # default is 123 flag => { type => 'int', default => 2 }, ], default_insert_changes_only => 1, default_update_changes_only => 1, ); package MySQLiteObject4; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MySQLiteObject4->meta->setup ( table => 'rose_db_object_test4', columns => [ id => { type => 'int', primary_key => 1 }, ], default_insert_changes_only => 1, default_update_changes_only => 1, ); } } END { # Delete test table if($HAVE_PG) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_private.rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_test2'); $dbh->do('DROP TABLE rose_db_object_test3'); $dbh->do('DROP TABLE rose_db_object_private.rose_db_object_test2'); $dbh->do('DROP TABLE rose_db_object_private.rose_db_object_test3'); $dbh->do('DROP SCHEMA rose_db_object_private CASCADE'); $dbh->disconnect; } if($HAVE_MYSQL) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_test2'); $dbh->do('DROP TABLE rose_db_object_test3'); $dbh->disconnect; } if($HAVE_INFORMIX) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } if($HAVE_SQLITE) { # SQLite my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_test2'); $dbh->do('DROP TABLE rose_db_object_test3'); $dbh->do('DROP TABLE rose_db_object_test4'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-changes-only-2.t000755 000765 000120 00000021526 11456603151 021224 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 2 + (71 * 4); require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Loader'); my $Include_Tables = '^(?:' . join('|', qw(rose_db_object_test)) . ')$'; $Include_Tables = qr($Include_Tables); use Rose::DB::Object::Util qw(:all); our $PG_HAS_CHKPASS; my %Value = ( 1 => 'varchar val', 2 => 'char val', 3 => 1, 4 => 4.25, 5 => '10111', 6 => 78.25, 7 => '1984-01-24', 8 => '1999-05-20 03:04:05', 9 => '2 years', 10 => [ 5, 6 ], 11 => 24, 12 => '922337203685', 13 => '1009539509', ); my %Default = ( 1 => 'varchar-def', 2 => 'char def ', 3 => 1, 4 => 1.25, 5 => '00101', 6 => 123.25, 7 => '2001-02-03', 8 => '2001-02-03 12:34:56', 9 => '@ 2 months 5 days 3 seconds', 10 => [ 3, 4 ], 11 => 123, 12 => '922337203685', 13 => '1973-02', ); my %Method = ( 5 => 'to_Bin', 7 => 'ymd', 8 => sub { shift; shift->strftime('%Y-%m-%d %H:%M:%S') }, 9 => sub { shift->db->format_interval(shift) }, 13 => sub { shift; shift->strftime('%Y-%m') }, ); # # Tests # foreach my $db_type (qw(pg mysql informix sqlite)) { unless(have_db($db_type)) { SKIP: { skip("$db_type tests", 71) } next; } Rose::DB::Object::Metadata->unregister_all_classes; Rose::DB->default_type($db_type); my $class_prefix = 'My' . ucfirst($db_type); my $loader = Rose::DB::Object::Loader->new( db_class => 'Rose::DB', class_prefix => $class_prefix, include_tables => $Include_Tables); $loader->make_classes; my $class = $class_prefix . '::RoseDbObjectTest'; $class->meta->replace_column(c13 => { type => 'epoch' }); $class->meta->replace_column(c13d => { type => 'epoch', default => 99539509 }); $class->meta->initialize(replace_existing => 1); #print $class->meta->perl_class_definition; add_nonpersistent_columns_and_methods($class); my $num_cols = 14; foreach my $n (1 .. $num_cols) { my $col = "c$n"; my $def = "c${n}d"; SKIP: { skip("column $n", 5) unless($class->meta->column($col)); } next unless($class->meta->column($col)); my $o = $class->new; $o->save; ok(!has_modified_columns($o), "has_modified_columns $col 1 - $db_type"); $o->$col($Value{$n}); is_deeply([ modified_column_names($o) ], [ $col ], "modified column $col 1 - $db_type"); foreach my $n (14 .. $num_cols) { my $col = "c$n"; my $def = "c${n}d"; next unless($class->meta->column($col)); my $val = $o->$col(); $val = $o->$def(); } is_deeply([ modified_column_names($o) ], [ $col ], "modified column $col 2 - $db_type"); #local $Rose::DB::Object::Debug = 1; $o->update(changes_only => 1); #local $Rose::DB::Object::Debug = 0; modify_nonpersistent_column_values($o); ok(!has_modified_columns($o), "has_modified_columns $col 2 - $db_type"); $o = $class->new(id => $o->id)->load; if(ref $Default{$n}) { is_deeply(scalar $o->$def(), $Default{$n}, "check default $def 1 - $db_type"); } else { my $method = $Method{$n}; my $value; if(defined $method) { if(ref $method eq 'CODE') { $value = $method->($o, $o->$def()); } else { $value = $o->$def()->$method(); } } else { $value = $o->$def; } if($db_type eq 'mysql' && $n == 2 && $o->db->database_version < 5_000_000) { $value .= ' '; # MySQL < 5 seems to mess up CHAR fields } if(defined $Default{$n}) { ok($value =~ /^\+?$Default{$n}$/, "check default $def 1 - $db_type"); } else { is($value, $Default{$n}, "check default $def 1 - $db_type"); } } if($n == 14 && $db_type eq 'pg') { ok($o->c14d_is('xyzzy'), "chkpass default - $db_type"); } elsif($n == 13 && $db_type eq 'pg' && !$PG_HAS_CHKPASS) { ok(1, "no chkpass - $db_type"); } elsif($n == 1 && $db_type ne 'pg') { ok(1, "chkpass skipped - $db_type"); } } } BEGIN { require 't/test-lib.pl'; # # PostgreSQL # if(have_db('pg_admin')) { my $dbh = get_dbh('pg_admin'); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } our $PG_HAS_CHKPASS = pg_has_chkpass(); $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, c1 VARCHAR(255), c1d VARCHAR(255) DEFAULT 'varchar-def', c2 CHAR(16), c2d CHAR(16) DEFAULT 'char def', c3 BOOLEAN, c3d BOOLEAN DEFAULT 't', c4 FLOAT, c4d FLOAT DEFAULT 1.25, c5 BIT(5), c5d BIT(5) DEFAULT B'00101', c6 DECIMAL(10,2), c6d DECIMAL(10,2) DEFAULT 123.25, c7 DATE, c7d DATE DEFAULT '2001-02-03', c8 TIMESTAMP, c8d TIMESTAMP DEFAULT '2001-02-03 12:34:56', c9 INTERVAL(6), c9d INTERVAL(6) DEFAULT '2 months 5 days 3 seconds', c10 INT[], c10d INT[] DEFAULT '{3,4}', c11 INT, c11d INT DEFAULT 123, c12 BIGINT, c12d BIGINT DEFAULT 922337203685, c13 INT, c13d INT DEFAULT 99539509 @{[ $PG_HAS_CHKPASS ? q(, c14 CHKPASS, c14d CHKPASS DEFAULT 'xyzzy') : '' ]} ) EOF $dbh->disconnect; } # # MySQL # my $db_version; eval { my $dbh = get_dbh('mysql_admin'); local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); }; if(have_db('mysql_admin')) { my $db = get_db('mysql_admin'); my $dbh = $db->retain_dbh; my $bool_columns = ($db->database_version >= 5_000_000) ? qq(c3 BOOLEAN,\n c3d BOOLEAN DEFAULT 1,) : ''; $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT AUTO_INCREMENT PRIMARY KEY, c1 VARCHAR(255), c1d VARCHAR(255) DEFAULT 'varchar-def', c2 CHAR(16), c2d CHAR(16) DEFAULT 'char def', $bool_columns c4 FLOAT, c4d FLOAT DEFAULT 1.25, c6 DECIMAL(10,2), c6d DECIMAL(10,2) DEFAULT 123.25, c7 DATE, c7d DATE DEFAULT '2001-02-03', c8 DATETIME, c8d DATETIME DEFAULT '2001-02-03 12:34:56', c11 INT, c11d INT DEFAULT 123, c12 BIGINT, c12d BIGINT DEFAULT 922337203685, c13 INT, c13d INT DEFAULT 99539509 ) EOF $dbh->disconnect; } # # Informix # if(have_db('informix_admin')) { my $dbh = get_dbh('informix_admin'); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, c1 VARCHAR(255), c1d VARCHAR(255) DEFAULT 'varchar-def', c2 CHAR(16), c2d CHAR(16) DEFAULT 'char def', c3 BOOLEAN, c3d BOOLEAN DEFAULT 't', c6 DECIMAL(10,2), c6d DECIMAL(10,2) DEFAULT 123.25, c7 DATE, c7d DATE DEFAULT '02/03/2001', -- DBD::Informix can't handle this default value, apparently... -- c8 DATETIME YEAR TO SECOND, -- c8d DATETIME YEAR TO SECOND DEFAULT DATETIME(2001-02-03 12:34:56) YEAR TO SECOND, c11 INT, c11d INT DEFAULT 123, c12 INT8, c12d INT8 DEFAULT 922337203685, c13 INT, c13d INT DEFAULT 99539509 ) EOF $dbh->disconnect; } # # SQLite # if(have_db('sqlite_admin')) { my $dbh = get_dbh('sqlite_admin'); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INTEGER PRIMARY KEY AUTOINCREMENT, c1 VARCHAR(255), c1d VARCHAR(255) DEFAULT 'varchar-def', c2 CHAR(16), c2d CHAR(16) DEFAULT 'char def', c3 BOOLEAN, c3d BOOLEAN DEFAULT 1, c4 REAL, c4d REAL DEFAULT '1.25', c6 REAL, c6d REAL DEFAULT '123.25', c7 DATE, c7d DATE DEFAULT '2001-02-03', c8 DATETIME, c8d DATETIME DEFAULT '2001-02-03 12:34:56', c11 INT, c11d INT DEFAULT 123, c12 BIGINT, c12d BIGINT DEFAULT 922337203685, c13 INT, c13d INT DEFAULT 99539509 ) EOF $dbh->disconnect; } } END { # Delete test tables if(have_db('pg_admin')) { my $dbh = get_dbh('pg_admin'); $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } if(have_db('mysql_admin')) { my $dbh = get_dbh('mysql_admin'); $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } if(have_db('informix_admin')) { my $dbh = get_dbh('informix_admin'); $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } if(have_db('sqlite_admin')) { my $dbh = get_dbh('sqlite_admin'); $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-convention.t000755 000765 000120 00000053711 11113677033 020661 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 183; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Manager'); use_ok('Rose::DB::Object::ConventionManager'); use_ok('Rose::DB::Object::ConventionManager::Null'); } # # related_table_to_class # my $cm = Rose::DB::Object::ConventionManager->new; is($cm->related_table_to_class('prices', 'My::Product'), 'My::Price', 'related_table_to_class 1'); is($cm->related_table_to_class('big_hats', 'A::B::FooBar'), 'A::B::BigHat', 'related_table_to_class 2'); is($cm->related_table_to_class('a1_steaks', 'Meat'), 'A1Steak', 'related_table_to_class 3'); # # table_to_class # is($cm->table_to_class('products', 'My::'), 'My::Product', 'table_to_class 1'); is($cm->table_to_class('products'), 'Product', 'table_to_class 2'); is($cm->table_to_class('big_hats', 'My::'), 'My::BigHat', 'table_to_class 3'); is($cm->table_to_class('my5_hat_pig'), 'My5HatPig', 'table_to_class 4'); # # singular_to_plural # is($cm->singular_to_plural('box'), 'boxes', 'singular_to_plural 1'); is($cm->singular_to_plural('dress'), 'dresses', 'singular_to_plural 2'); is($cm->singular_to_plural('ceres'), 'cereses', 'singular_to_plural 3'); is($cm->singular_to_plural('daisy'), 'daisies', 'singular_to_plural 4'); is($cm->singular_to_plural('dogs'), 'dogs', 'singular_to_plural 5'); is($cm->singular_to_plural('product'), 'products', 'singular_to_plural 6'); # # plural_to_singular # is($cm->plural_to_singular('daisies'), 'daisy', 'plural_to_singular 1'); is($cm->plural_to_singular('dresses'), 'dress', 'plural_to_singular 2'); is($cm->plural_to_singular('dress'), 'dress', 'plural_to_singular 3'); is($cm->plural_to_singular('products'), 'product', 'plural_to_singular 4'); # # is_singleton # my $cm1 = Rose::DB::Object::ConventionManager::Null->new; my $cm2 = Rose::DB::Object::ConventionManager::Null->new; is($cm1, $cm2, 'null singleton'); # # auto_manager_* # is($cm->auto_manager_base_class, 'Rose::DB::Object::Manager', 'auto_manager_base_class'); is($cm->auto_manager_class_name('My::Object'), 'My::Object::Manager', 'auto_manager_class_name'); AUTO_MANAGER_CLASS_TEST: { package My::Dog; @My::Dog::ISA = 'Rose::DB::Object'; my $dog_cm = My::Dog->meta->convention_manager; package main; is($dog_cm->auto_manager_class_name, 'My::Dog::Manager', 'auto_manager_base_class no args'); is($dog_cm->auto_manager_base_name, 'dogs', 'auto_manager_base_name with no args'); is($dog_cm->auto_manager_base_name('products'), 'products', 'auto_manager_base_name with table'); is($dog_cm->auto_manager_base_name('dogs', 'My::Dog'), 'dogs', 'auto_manager_base_name with table and class'); } is($cm->auto_manager_method_name('doesntmatter'), undef, 'auto_manager_method_name'); # # auto_table # my %Expect_Table = ( 'OtherObject' => 'other_objects', 'My::OtherObject' => 'other_objects', 'My::Other::Object' => 'objects', 'Other123Object' => 'other123_objects', 'My::Other123Object' => 'other123_objects', 'My::Other::123Object' => '123_objects', 'Mess2' => 'mess2s', 'Mess' => 'messes', 'My::Mess' => 'messes', 'My::Other::Mess' => 'messes', 'Box' => 'boxes', 'My::Box' => 'boxes', 'My::Other::Box' => 'boxes', ); foreach my $pkg (sort keys %Expect_Table) { no strict 'refs'; @{"${pkg}::ISA"} = qw(Rose::DB::Object); *{"${pkg}::init_db"} = sub { Rose::DB->new('pg') }; is($pkg->meta->table, $Expect_Table{$pkg}, "auto_table $pkg"); } SKIP: { eval "require Lingua::EN::Inflect"; skip('missing Lingua::EN::Inflect 1.89', 19) if($@ || $Lingua::EN::Inflect::VERSION != 1.89); %Expect_Table = ( 'OtherPerson' => 'other_people', 'My::Person' => 'people', 'My::Other::Person' => 'people', 'Other123Person' => 'other123_people', 'My::Other123Person' => 'other123_people', 'My::Other::123Person' => '123_people', 'MyMess2' => 'my_mess2s', 'My2Mess' => 'my2_messes', 'My2::Mess' => 'messes', 'My2::Other::Mess' => 'messes', 'Deer' => 'deer', 'My::Deer' => 'deer', 'My::Other::Deer' => 'deer', 'Alumnus' => 'alumni', 'My::Alumnus' => 'alumni', 'My::Other::Alumnus' => 'alumni', 'pBox' => 'p_boxes', 'My::pBox' => 'p_boxes', 'My::Other::pBox' => 'p_boxes', ); foreach my $pkg (sort keys %Expect_Table) { no strict 'refs'; @{"${pkg}::ISA"} = qw(Rose::DB::Object); *{"${pkg}::init_db"} = sub { Rose::DB->new('pg') }; $pkg->meta->convention_manager->singular_to_plural_function(\&Lingua::EN::Inflect::PL_N); is($pkg->meta->table, $Expect_Table{$pkg}, "auto_table en $pkg"); } } My::OtherObject->meta->columns ( name => { type => 'varchar'}, k1 => { type => 'int' }, k2 => { type => 'int' }, k3 => { type => 'int' }, ); My::OtherObject->meta->primary_key_columns([ qw(k1 k2 k3) ]); My::OtherObject->meta->initialize; # # auto_table_name # AUTO_TABLE: { package My::AutoTable; @My::AutoTable::ISA = ('Rose::DB::Object'); My::AutoTable->meta->convention_manager->tables_are_singular(1); Test::More::is(My::AutoTable->meta->table, 'auto_table', 'auto_table_name() singular'); My::AutoTable->meta->convention_manager->tables_are_singular(0); My::AutoTable->meta->table(undef); Test::More::is(My::AutoTable->meta->table, 'auto_tables', 'auto_table_name() plural'); } # # auto_primary_key_columns # PK_ID: { package My::PKClass1; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns ( 'name', 'id', 'object_id', ); my @columns = __PACKAGE__->meta->primary_key_column_names; Test::More::ok(@columns == 1 && $columns[0] eq 'id', 'auto_primary_key_column_names id'); } PK_OBJECT_ID: { package My::PK::OtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns ( 'name', 'other_object_id', ); my @columns = __PACKAGE__->meta->primary_key_column_names; Test::More::ok(@columns == 1 && $columns[0] eq 'other_object_id', 'auto_primary_key_column_names other_object_id'); } PK_SERIAL_ID: { package My::PKSerial::OtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns ( 'pk' => { type => 'serial' }, 'roo' => { type => 'serial' }, 'foo', ); my @columns = __PACKAGE__->meta->primary_key_column_names; Test::More::ok(@columns == 1 && $columns[0] eq 'pk', 'auto_primary_key_column_names pk'); } # # auto_column_method_name # COLUMN_METHOD: { package MyColumnCM; our @ISA = qw(Rose::DB::Object::ConventionManager); sub auto_column_method_name { my($self, $type, $column, $name, $object_class) = @_; return $column->is_primary_key_member ? $name : "x_${type}_$name"; } package MyColumnObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } MyColumnObject->meta->convention_manager('MyColumnCM'); __PACKAGE__->meta->columns(qw(id a b)); __PACKAGE__->meta->initialize; package main; my $o = MyColumnObject->new; ok($o->can('id'), 'auto_column_method_name 1'); ok($o->can('x_get_set_a'), 'auto_column_method_name 2'); ok($o->can('x_get_set_b'), 'auto_column_method_name 3'); ok(!$o->can('a'), 'auto_column_method_name 4'); ok(!$o->can('b'), 'auto_column_method_name 5'); } # # auto_foreign_key # FK1: { package My::FK1::OtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id name)); __PACKAGE__->meta->initialize; package My::FK1::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id other_object_id)); __PACKAGE__->meta->foreign_keys(qw(other_object)); __PACKAGE__->meta->initialize; } my $fk = My::FK1::Object->meta->foreign_key('other_object'); ok($fk, 'auto_foreign_key 1'); is($fk->class, 'My::FK1::OtherObject', 'auto_foreign_key 2'); my $kc = $fk->key_columns; is(scalar keys %$kc, 1, 'auto_foreign_key 3'); is($kc->{'other_object_id'}, 'id', 'auto_foreign_key 4'); FK2: { package My::FK2::OtherObj; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id name)); __PACKAGE__->meta->initialize; package My::FK2::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id other_object_id)); __PACKAGE__->meta->foreign_keys ( other_object => { class => 'My::FK2::OtherObj', } ); __PACKAGE__->meta->initialize; } $fk = My::FK2::Object->meta->foreign_key('other_object'); ok($fk, 'auto_foreign_key 5'); is($fk->class, 'My::FK2::OtherObj', 'auto_foreign_key 6'); $kc = $fk->key_columns; is(scalar keys %$kc, 1, 'auto_foreign_key 7'); is($kc->{'other_object_id'}, 'id', 'auto_foreign_key 8'); FK3: { package My::FK3::OtherObj; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(eyedee => { type => 'serial' }, 'name'); __PACKAGE__->meta->initialize; package My::FK3::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id other_obj_eyedee)); __PACKAGE__->meta->foreign_keys ( other_obj => { key_columns => { other_obj_eyedee => 'eyedee' }, } ); __PACKAGE__->meta->initialize; } $fk = My::FK3::Object->meta->foreign_key('other_obj'); ok($fk, 'auto_foreign_key 9'); is($fk->class, 'My::FK3::OtherObj', 'auto_foreign_key 10'); $kc = $fk->key_columns; is(scalar keys %$kc, 1, 'auto_foreign_key 11'); is($kc->{'other_obj_eyedee'}, 'eyedee', 'auto_foreign_key 12'); FK4: { package My::FK4::OtherObj; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(eyedee => { type => 'serial' }, 'name'); __PACKAGE__->meta->initialize; package My::FK4::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id other_obj_eyedee)); __PACKAGE__->meta->foreign_keys(qw(other_obj)); __PACKAGE__->meta->initialize; } $fk = My::FK4::Object->meta->foreign_key('other_obj'); ok($fk, 'auto_foreign_key 13'); is($fk->class, 'My::FK4::OtherObj', 'auto_foreign_key 14'); $kc = $fk->key_columns; is(scalar keys %$kc, 1, 'auto_foreign_key 15'); is($kc->{'other_obj_eyedee'}, 'eyedee', 'auto_foreign_key 16'); # # auto_relationship # # one to one OTO1: { package My::OTO1::OtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id name)); __PACKAGE__->meta->initialize; package My::OTO1::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id other_object_id)); __PACKAGE__->meta->relationships(other_object => 'one to one'); __PACKAGE__->meta->initialize; } my $rel = My::OTO1::Object->meta->relationship('other_object'); ok($rel, 'auto_relationship one to one 1'); is($rel->class, 'My::OTO1::OtherObject', 'auto_relationship one to one 2'); $cm = $rel->column_map; is(scalar keys %$cm, 1, 'auto_relationship one to one 3'); is($cm->{'other_object_id'}, 'id', 'auto_relationship one to one 4'); OTO2: { package My::OTO2::OtherObj; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id name)); __PACKAGE__->meta->initialize; package My::OTO2::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id other_object_id)); __PACKAGE__->meta->relationships ( other_object => { type => 'one to one', class => 'My::OTO2::OtherObj', } ); __PACKAGE__->meta->initialize; } $rel = My::OTO2::Object->meta->relationship('other_object'); ok($rel, 'auto_relationship one to one 5'); is($rel->class, 'My::OTO2::OtherObj', 'auto_relationship one to one 6'); $cm = $rel->column_map; is(scalar keys %$cm, 1, 'auto_relationship one to one 7'); is($cm->{'other_object_id'}, 'id', 'auto_relationship one to one 8'); OTO3: { package My::OTO3::OtherObj; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(eyedee => { type => 'serial' }, 'name'); __PACKAGE__->meta->initialize; package My::OTO3::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id other_obj_id)); __PACKAGE__->meta->relationships ( other_obj => { type => 'one to one', column_map => { other_obj_id => 'eyedee' }, } ); __PACKAGE__->meta->initialize; } $rel = My::OTO3::Object->meta->relationship('other_obj'); ok($rel, 'auto_relationship one to one 9'); is($rel->class, 'My::OTO3::OtherObj', 'auto_relationship one to one 10'); $cm = $rel->column_map; is(scalar keys %$cm, 1, 'auto_relationship one to one 11'); is($cm->{'other_obj_id'}, 'eyedee', 'auto_relationship one to one 12'); OTO4: { package My::OTO4::OtherObj; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(eyedee => { type => 'serial' }, 'name'); __PACKAGE__->meta->initialize; package My::OTO4::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id other_obj_eyedee)); __PACKAGE__->meta->relationships ( other_obj => { type => 'one to one' } ); __PACKAGE__->meta->initialize; } $rel = My::OTO4::Object->meta->relationship('other_obj'); ok($rel, 'auto_relationship one to one 13'); is($rel->class, 'My::OTO4::OtherObj', 'auto_relationship one to one 14'); $cm = $rel->column_map; is(scalar keys %$cm, 1, 'auto_relationship one to one 15'); is($cm->{'other_obj_eyedee'}, 'eyedee', 'auto_relationship one to one 16'); # many to one MTO1: { package My::MTO1::OtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id name)); __PACKAGE__->meta->initialize; package My::MTO1::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id other_object_id)); __PACKAGE__->meta->relationships(other_object => 'many to one'); __PACKAGE__->meta->initialize; } $rel = My::MTO1::Object->meta->relationship('other_object'); ok($rel, 'auto_relationship many to one 1'); is($rel->class, 'My::MTO1::OtherObject', 'auto_relationship many to one 2'); $cm = $rel->column_map; is(scalar keys %$cm, 1, 'auto_relationship many to one 3'); is($cm->{'other_object_id'}, 'id', 'auto_relationship many to one 4'); MTO2: { package My::MTO2::OtherObj; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id name)); __PACKAGE__->meta->initialize; package My::MTO2::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id other_object_id)); __PACKAGE__->meta->relationships ( other_object => { type => 'many to one', class => 'My::MTO2::OtherObj', } ); __PACKAGE__->meta->initialize; } $rel = My::MTO2::Object->meta->relationship('other_object'); ok($rel, 'auto_relationship many to one 5'); is($rel->class, 'My::MTO2::OtherObj', 'auto_relationship many to one 6'); $cm = $rel->column_map; is(scalar keys %$cm, 1, 'auto_relationship many to one 7'); is($cm->{'other_object_id'}, 'id', 'auto_relationship many to one 8'); MTO3: { package My::MTO3::OtherObj; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(eyedee => { type => 'serial' }, 'name'); __PACKAGE__->meta->initialize; package My::MTO3::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id other_obj_id)); __PACKAGE__->meta->relationships ( other_obj => { type => 'many to one', column_map => { other_obj_id => 'eyedee' }, } ); __PACKAGE__->meta->initialize; } $rel = My::MTO3::Object->meta->relationship('other_obj'); ok($rel, 'auto_relationship many to one 9'); is($rel->class, 'My::MTO3::OtherObj', 'auto_relationship many to one 10'); $cm = $rel->column_map; is(scalar keys %$cm, 1, 'auto_relationship many to one 11'); is($cm->{'other_obj_id'}, 'eyedee', 'auto_relationship many to one 12'); MTO4: { package My::MTO4::OtherObj; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(eyedee => { type => 'serial' }, 'name'); __PACKAGE__->meta->initialize; package My::MTO4::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id other_obj_eyedee)); __PACKAGE__->meta->relationships ( other_obj => { type => 'many to one' } ); __PACKAGE__->meta->initialize; } $rel = My::MTO4::Object->meta->relationship('other_obj'); ok($rel, 'auto_relationship many to one 13'); is($rel->class, 'My::MTO4::OtherObj', 'auto_relationship many to one 14'); $cm = $rel->column_map; is(scalar keys %$cm, 1, 'auto_relationship many to one 15'); is($cm->{'other_obj_eyedee'}, 'eyedee', 'auto_relationship many to one 16'); # one to many OTM1: { package My::OTM1::OtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id name object_id)); __PACKAGE__->meta->initialize; package My::OTM1::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id name)); __PACKAGE__->meta->relationships(other_objects => 'one to many'); __PACKAGE__->meta->initialize; } $rel = My::OTM1::Object->meta->relationship('other_objects'); ok($rel, 'auto_relationship one to many 1'); is($rel->class, 'My::OTM1::OtherObject', 'auto_relationship one to many 2'); $cm = $rel->column_map; is(scalar keys %$cm, 1, 'auto_relationship one to many 3'); is($cm->{'id'}, 'object_id', 'auto_relationship one to many 4'); OTM2: { package My::OTM2::OtherObj; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id name object_id)); __PACKAGE__->meta->initialize; package My::OTM2::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id name)); __PACKAGE__->meta->relationships ( other_objects => { type => 'one to many', class => 'My::OTM2::OtherObj', } ); __PACKAGE__->meta->initialize; } $rel = My::OTM2::Object->meta->relationship('other_objects'); ok($rel, 'auto_relationship one to many 5'); is($rel->class, 'My::OTM2::OtherObj', 'auto_relationship one to many 6'); $cm = $rel->column_map; is(scalar keys %$cm, 1, 'auto_relationship one to many 7'); is($cm->{'id'}, 'object_id', 'auto_relationship one to many 8'); OTM3: { package My::OTM3::OtherObj; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(meyedee => { type => 'serial' }, 'name', 'object_eyedee'); __PACKAGE__->meta->initialize; package My::OTM3::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(eyedee => { type => 'serial' }, 'name'); __PACKAGE__->meta->relationships ( other_obj => { type => 'one to many', column_map => { eyedee => 'object_eyedee' }, } ); __PACKAGE__->meta->initialize; } $rel = My::OTM3::Object->meta->relationship('other_obj'); ok($rel, 'auto_relationship one to many 9'); is($rel->class, 'My::OTM3::OtherObj', 'auto_relationship one to many 10'); $cm = $rel->column_map; is(scalar keys %$cm, 1, 'auto_relationship one to many 11'); is($cm->{'eyedee'}, 'object_eyedee', 'auto_relationship one to many 12'); OTM4: { package My::OTM4::OtherObj; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(meyedee => { type => 'serial' }, 'name', 'object_eyedee'); __PACKAGE__->meta->initialize; package My::OTM4::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(eyedee => { type => 'serial' }, 'name'); __PACKAGE__->meta->relationships ( other_objs => { type => 'one to many' } ); __PACKAGE__->meta->initialize; } $rel = My::OTM4::Object->meta->relationship('other_objs'); ok($rel, 'auto_relationship one to many 13'); is($rel->class, 'My::OTM4::OtherObj', 'auto_relationship one to many 14'); $cm = $rel->column_map; is(scalar keys %$cm, 1, 'auto_relationship one to many 15'); is($cm->{'eyedee'}, 'object_eyedee', 'auto_relationship one to many 16'); # many to many my $i = 0; my @map_classes = qw(ObjectsOtherObjectsMap ObjectOtherObjectMap OtherObjectsObjectsMap OtherObjectObjectMap ObjectsOtherObjects ObjectOtherObjects OtherObjectsObjects OtherObjectObjects OtherObjectMap OtherObjectsMap ObjectMap ObjectsMap); foreach my $class (@map_classes) { $i++; my $defs=<<"EOF"; package My::MTM${i}::$class; our \@ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id object_id other_object_id)); package My::MTM${i}::OtherObject; our \@ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id name)); __PACKAGE__->meta->initialize; package My::MTM${i}::Object; our \@ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->columns(qw(id name)); My::MTM${i}::$class->meta->foreign_keys(qw(object other_object)); My::MTM${i}::$class->meta->initialize; My::MTM${i}::Object->meta->relationships(other_objects => 'many to many'); My::MTM${i}::Object->meta->initialize EOF eval $defs; die $@ if($@); my $obj_class = "My::MTM${i}::Object"; $rel = $obj_class->meta->relationship('other_objects'); ok($rel, "auto_relationship many to many $i.1"); is($rel->map_class, "My::MTM${i}::$class", "auto_relationship many to many $i.2"); is($rel->map_from, 'object', "auto_relationship many to many $i.3"); is($rel->map_to, 'other_object', "auto_relationship many to many $i.4"); } Rose-DB-Object-0.810/t/db-object-foreign-key-auto.t000755 000765 000120 00000220102 12054157213 021650 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 262; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); } our($PG_HAS_CHKPASS, $HAVE_PG, $HAVE_MYSQL_WITH_INNODB, $HAVE_INFORMIX, $HAVE_SQLITE); # # PostgreSQL # SKIP: foreach my $db_type ('pg') { skip("PostgreSQL tests", 74) unless($HAVE_PG); Rose::DB->default_type($db_type); my $o = MyPgObject->new(name => 'John'); ok(ref $o && $o->isa('MyPgObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(7); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); my $o2 = MyPgObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyPgObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 7, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyPgObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyPgObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->load, "load() 4 - $db_type"); SKIP: { if($PG_HAS_CHKPASS) { $o->{'password_encrypted'} = ':8R1Kf2nOS0bRE'; ok($o->password_is('xyzzy'), "chkpass() 1 - $db_type"); is($o->password, 'xyzzy', "chkpass() 2 - $db_type"); $o->password('foobar'); ok($o->password_is('foobar'), "chkpass() 3 - $db_type"); is($o->password, 'foobar', "chkpass() 4 - $db_type"); ok($o->save, "save() 3 - $db_type"); } else { skip("chkpass tests", 5); } } my $o5 = MyPgObject->new(id => $o->id); ok($o5->load, "load() 5 - $db_type"); SKIP: { if($PG_HAS_CHKPASS) { ok($o5->password_is('foobar'), "chkpass() 5 - $db_type"); is($o5->password, 'foobar', "chkpass() 6 - $db_type"); } else { skip("chkpass tests", 2); } } $o5->nums([ 4, 5, 6 ]); ok($o5->save, "save() 4 - $db_type"); ok($o->load, "load() 6 - $db_type"); is($o5->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o5->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o5->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o5->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); my $oo1 = MyPgOtherObject->new(k1 => 1, k2 => 2, k3 => 3, name => 'one'); ok($oo1->save, 'other object save() 1'); my $oo2 = MyPgOtherObject->new(k1 => 11, k2 => 12, k3 => 13, name => 'two'); ok($oo2->save, 'other object save() 2'); my $other2 = MyPgOtherObject2->new(id2 => 12, name => 'twelve'); ok($other2->save, 'other 2 object save() 1'); my $other3 = MyPgOtherObject3->new(id3 => 13, name => 'thirteen'); ok($other3->save, 'other 3 object save() 1'); my $other4 = MyPgOtherObject4->new(id4 => 14, name => 'fourteen'); ok($other4->save, 'other 4 object save() 1'); is($o->fother, undef, 'fother() 1'); is($o->fother2, undef, 'fother2() 1'); is($o->fother3, undef, 'fother3() 1'); is($o->my_pg_other_object, undef, 'my_pg_other_object() 1'); $o->fother_id2(12); $o->fother_id3(13); $o->fother_id4(14); $o->fkone(1); $o->fk2(2); $o->fk3(3); my $obj = $o->my_pg_other_object or warn "# ", $o->error, "\n"; is(ref $obj, 'MyPgOtherObject', 'my_pg_other_object() 2'); is($obj->name, 'one', 'my_pg_other_object() 3'); $obj = $o->fother or warn "# ", $o->error, "\n"; is(ref $obj, 'MyPgOtherObject2', 'fother() 2'); is($obj->name, 'twelve', 'fother() 3'); $obj = $o->fother2 or warn "# ", $o->error, "\n"; is(ref $obj, 'MyPgOtherObject3', 'fother2() 2'); is($obj->name, 'thirteen', 'fother2() 3'); $obj = $o->fother3 or warn "# ", $o->error, "\n"; is(ref $obj, 'MyPgOtherObject4', 'fother3() 2'); is($obj->name, 'fourteen', 'fother3() 3'); $o->my_pg_other_object(undef); $o->fkone(11); $o->fk2(12); $o->fk3(13); $obj = $o->my_pg_other_object or warn "# ", $o->error, "\n"; is(ref $obj, 'MyPgOtherObject', 'my_pg_other_object() 4'); is($obj->name, 'two', 'my_pg_other_object() 5'); ok($o->delete, "delete() - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, 'alias_column() nonesuch'); # # Test code generation # is(MyPgObject->meta->perl_foreign_keys_definition, <<'EOF', "perl_foreign_keys_definition 1 - $db_type"); __PACKAGE__->meta->foreign_keys( fother => { class => 'MyPgOtherObject2', key_columns => { fother_id2 => 'id2' }, }, fother2 => { class => 'MyPgOtherObject3', key_columns => { fother_id3 => 'id3' }, }, fother3 => { class => 'MyPgOtherObject4', key_columns => { fother_id4 => 'id4' }, }, my_pg_other_object => { class => 'MyPgOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ); EOF is(MyPgObject->meta->perl_foreign_keys_definition(braces => 'bsd', indent => 2), <<'EOF', "perl_foreign_keys_definition 2 - $db_type"); __PACKAGE__->meta->foreign_keys ( fother => { class => 'MyPgOtherObject2', key_columns => { fother_id2 => 'id2' }, }, fother2 => { class => 'MyPgOtherObject3', key_columns => { fother_id3 => 'id3' }, }, fother3 => { class => 'MyPgOtherObject4', key_columns => { fother_id4 => 'id4' }, }, my_pg_other_object => { class => 'MyPgOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ); EOF my $chkpass = $PG_HAS_CHKPASS ? " password => { type => 'chkpass' },\n" : ''; is(MyPgObject->meta->perl_class_definition(use_setup => 0), <<"EOF", "perl_class_definition (trad) 1 - $db_type"); package MyPgObject; use strict; use base qw(Rose::DB::Object); __PACKAGE__->meta->table('Rose_db_object_test'); __PACKAGE__->meta->columns( id => { type => 'serial', not_null => 1 }, $chkpass name => { type => 'varchar', length => 32, not_null => 1 }, flag => { type => 'boolean', default => 'true', not_null => 1 }, flag2 => { type => 'boolean' }, status => { type => 'varchar', default => 'active', length => 32 }, bits => { type => 'bitfield', bits => 5, default => '00101', not_null => 1 }, start => { type => 'date', default => '1980-12-24' }, save => { type => 'integer', alias => 'save_col' }, nums => { type => 'array' }, fk1 => { type => 'integer', alias => 'fkone' }, fk2 => { type => 'integer' }, fk3 => { type => 'integer' }, fother_id2 => { type => 'integer' }, fother_id3 => { type => 'integer' }, fother_id4 => { type => 'integer' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); __PACKAGE__->meta->primary_key_columns([ 'id' ]); __PACKAGE__->meta->foreign_keys( fother => { class => 'MyPgOtherObject2', key_columns => { fother_id2 => 'id2' }, }, fother2 => { class => 'MyPgOtherObject3', key_columns => { fother_id3 => 'id3' }, }, fother3 => { class => 'MyPgOtherObject4', key_columns => { fother_id4 => 'id4' }, }, my_pg_other_object => { class => 'MyPgOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ); __PACKAGE__->meta->initialize; 1; EOF $chkpass = $PG_HAS_CHKPASS ? " password => { type => 'chkpass' },\n" : ''; is(MyPgObject->meta->perl_class_definition, <<"EOF", "perl_class_definition 1 - $db_type"); package MyPgObject; use strict; use base qw(Rose::DB::Object); __PACKAGE__->meta->setup( table => 'Rose_db_object_test', columns => [ id => { type => 'serial', not_null => 1 }, $chkpass name => { type => 'varchar', length => 32, not_null => 1 }, flag => { type => 'boolean', default => 'true', not_null => 1 }, flag2 => { type => 'boolean' }, status => { type => 'varchar', default => 'active', length => 32 }, bits => { type => 'bitfield', bits => 5, default => '00101', not_null => 1 }, start => { type => 'date', default => '1980-12-24' }, save => { type => 'integer', alias => 'save_col' }, nums => { type => 'array' }, fk1 => { type => 'integer', alias => 'fkone' }, fk2 => { type => 'integer' }, fk3 => { type => 'integer' }, fother_id2 => { type => 'integer' }, fother_id3 => { type => 'integer' }, fother_id4 => { type => 'integer' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ], primary_key_columns => [ 'id' ], foreign_keys => [ fother => { class => 'MyPgOtherObject2', key_columns => { fother_id2 => 'id2' }, }, fother2 => { class => 'MyPgOtherObject3', key_columns => { fother_id3 => 'id3' }, }, fother3 => { class => 'MyPgOtherObject4', key_columns => { fother_id4 => 'id4' }, }, my_pg_other_object => { class => 'MyPgOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ], ); 1; EOF $chkpass = $PG_HAS_CHKPASS ? " password => { type => 'chkpass' },\n" : ''; MyPgObject->meta->auto_load_related_classes(1); is(MyPgObject->meta->perl_class_definition(braces => 'bsd', indent => 2, use_setup => 0), <<"EOF", "perl_class_definition (trad) 2 - $db_type"); package MyPgObject; use strict; use base qw(Rose::DB::Object); __PACKAGE__->meta->table('Rose_db_object_test'); __PACKAGE__->meta->columns ( id => { type => 'serial', not_null => 1 }, $chkpass name => { type => 'varchar', length => 32, not_null => 1 }, flag => { type => 'boolean', default => 'true', not_null => 1 }, flag2 => { type => 'boolean' }, status => { type => 'varchar', default => 'active', length => 32 }, bits => { type => 'bitfield', bits => 5, default => '00101', not_null => 1 }, start => { type => 'date', default => '1980-12-24' }, save => { type => 'integer', alias => 'save_col' }, nums => { type => 'array' }, fk1 => { type => 'integer', alias => 'fkone' }, fk2 => { type => 'integer' }, fk3 => { type => 'integer' }, fother_id2 => { type => 'integer' }, fother_id3 => { type => 'integer' }, fother_id4 => { type => 'integer' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); __PACKAGE__->meta->primary_key_columns([ 'id' ]); __PACKAGE__->meta->foreign_keys ( fother => { class => 'MyPgOtherObject2', key_columns => { fother_id2 => 'id2' }, }, fother2 => { class => 'MyPgOtherObject3', key_columns => { fother_id3 => 'id3' }, }, fother3 => { class => 'MyPgOtherObject4', key_columns => { fother_id4 => 'id4' }, }, my_pg_other_object => { class => 'MyPgOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ); __PACKAGE__->meta->initialize; 1; EOF $chkpass = $PG_HAS_CHKPASS ? " password => { type => 'chkpass' },\n" : ''; MyPgObject->meta->auto_load_related_classes(0); is(MyPgObject->meta->perl_class_definition, <<"EOF", "perl_class_definition 2 - $db_type"); package MyPgObject; use strict; use base qw(Rose::DB::Object); use MyPgOtherObject; use MyPgOtherObject2; use MyPgOtherObject3; use MyPgOtherObject4; __PACKAGE__->meta->setup( table => 'Rose_db_object_test', columns => [ id => { type => 'serial', not_null => 1 }, $chkpass name => { type => 'varchar', length => 32, not_null => 1 }, flag => { type => 'boolean', default => 'true', not_null => 1 }, flag2 => { type => 'boolean' }, status => { type => 'varchar', default => 'active', length => 32 }, bits => { type => 'bitfield', bits => 5, default => '00101', not_null => 1 }, start => { type => 'date', default => '1980-12-24' }, save => { type => 'integer', alias => 'save_col' }, nums => { type => 'array' }, fk1 => { type => 'integer', alias => 'fkone' }, fk2 => { type => 'integer' }, fk3 => { type => 'integer' }, fother_id2 => { type => 'integer' }, fother_id3 => { type => 'integer' }, fother_id4 => { type => 'integer' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ], primary_key_columns => [ 'id' ], foreign_keys => [ fother => { class => 'MyPgOtherObject2', key_columns => { fother_id2 => 'id2' }, }, fother2 => { class => 'MyPgOtherObject3', key_columns => { fother_id3 => 'id3' }, }, fother3 => { class => 'MyPgOtherObject4', key_columns => { fother_id4 => 'id4' }, }, my_pg_other_object => { class => 'MyPgOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ], ); 1; EOF } # # MySQL # SKIP: foreach my $db_type ('mysql') { skip("MySQL tests", 55) unless($HAVE_MYSQL_WITH_INNODB); Rose::DB->default_type($db_type); my $o = MyMySQLObject->new(name => 'John'); ok(ref $o && $o->isa('MyMySQLObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(22); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); my $o2 = MyMySQLObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyMySQLObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 22, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyMySQLObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyMySQLObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); my $oo1 = MyMySQLOtherObject->new(k1 => 1, k2 => 2, k3 => 3, name => 'one'); ok($oo1->save, 'other object save() 1'); my $oo2 = MyMySQLOtherObject->new(k1 => 11, k2 => 12, k3 => 13, name => 'two'); ok($oo2->save, 'other object save() 2'); my $other2 = MyMySQLOtherObject2->new(id2 => 12, name => 'twelve'); ok($other2->save, 'other 2 object save() 1'); my $other3 = MyMySQLOtherObject3->new(id3 => 13, name => 'thirteen'); ok($other3->save, 'other 3 object save() 1'); my $other4 = MyMySQLOtherObject4->new(id4 => 14, name => 'fourteen'); ok($other4->save, 'other 4 object save() 1'); is($o->fother, undef, 'fother() 1'); is($o->fother2, undef, 'fother2() 1'); is($o->fother3, undef, 'fother3() 1'); is($o->my_my_sqlother_object, undef, 'my_my_sqlother_object() 1'); $o->fother_id2(12); $o->fother_id3(13); $o->fother_id4(14); $o->fkone(1); $o->fk2(2); $o->fk3(3); my $obj = $o->my_my_sqlother_object or warn "# ", $o->error, "\n"; is(ref $obj, 'MyMySQLOtherObject', 'my_my_sqlother_object() 2'); is($obj->name, 'one', 'my_my_sqlother_object() 3'); $obj = $o->fother or warn "# ", $o->error, "\n"; is(ref $obj, 'MyMySQLOtherObject2', 'fother() 2'); is($obj->name, 'twelve', 'fother() 3'); $obj = $o->fother2 or warn "# ", $o->error, "\n"; is(ref $obj, 'MyMySQLOtherObject3', 'fother2() 2'); is($obj->name, 'thirteen', 'fother2() 3'); $obj = $o->fother3 or warn "# ", $o->error, "\n"; is(ref $obj, 'MyMySQLOtherObject4', 'fother3() 2'); is($obj->name, 'fourteen', 'fother3() 3'); $o->my_my_sqlother_object(undef); $o->fkone(11); $o->fk2(12); $o->fk3(13); $obj = $o->my_my_sqlother_object or warn "# ", $o->error, "\n"; is(ref $obj, 'MyMySQLOtherObject', 'my_my_sqlother_object() 4'); is($obj->name, 'two', 'my_my_sqlother_object() 5'); ok($o->delete, "delete() - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, 'alias_column() nonesuch'); # # Test code generation # is(MyMySQLObject->meta->perl_foreign_keys_definition, <<'EOF', "perl_foreign_keys_definition 1 - $db_type"); __PACKAGE__->meta->foreign_keys( fother => { class => 'MyMySQLOtherObject2', key_columns => { fother_id2 => 'id2' }, }, fother2 => { class => 'MyMySQLOtherObject3', key_columns => { fother_id3 => 'id3' }, }, fother3 => { class => 'MyMySQLOtherObject4', key_columns => { fother_id4 => 'id4' }, }, my_my_sqlother_object => { class => 'MyMySQLOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ); EOF is(MyMySQLObject->meta->perl_foreign_keys_definition(braces => 'bsd', indent => 2), <<'EOF', "perl_foreign_keys_definition 2 - $db_type"); __PACKAGE__->meta->foreign_keys ( fother => { class => 'MyMySQLOtherObject2', key_columns => { fother_id2 => 'id2' }, }, fother2 => { class => 'MyMySQLOtherObject3', key_columns => { fother_id3 => 'id3' }, }, fother3 => { class => 'MyMySQLOtherObject4', key_columns => { fother_id4 => 'id4' }, }, my_my_sqlother_object => { class => 'MyMySQLOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ); EOF my $mysql_41 = ($o->db->database_version >= 4_100_000) ? 1 : 0; my $mysql_5 = ($o->db->database_version >= 5_000_000) ? 1 : 0; my $mylsq_5_51 = ($o->db->database_version >= 5_000_051) ? 1 : 0; # XXX: Lame my $no_empty_def = (MyMySQLObject->meta->perl_class_definition(use_setup => 0) !~ /default => '', / ? 1 : 0); my $set_col = $mysql_5 ? q(items => { type => 'set', default => 'a,c', not_null => 1, values => [ 'a', 'b', 'c' ] },) : q(items => { type => 'varchar', default => 'a,c', length => 255, not_null => 1 },); no warnings 'once'; local $Rose::DB::Object::Metadata::Auto::Sort_Columns_Alphabetically = 1; my $serial = $o->db->dbh->{'Driver'}{'Version'} >= 4.002 ? 'serial' : 'integer'; is(MyMySQLObject->meta->perl_class_definition(use_setup => 0), <<"EOF", "perl_class_definition (trad) 1 - $db_type"); package MyMySQLObject; use strict; use base qw(Rose::DB::Object); __PACKAGE__->meta->table('Rose_db_object_test'); __PACKAGE__->meta->columns( bits => { type => 'bitfield', bits => 5, default => 101 }, date_created => { type => 'datetime' }, fk1 => { type => 'integer', alias => 'fkone' }, fk2 => { type => 'integer' }, fk3 => { type => 'integer' }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, fother_id2 => { type => 'integer' }, fother_id3 => { type => 'integer' }, fother_id4 => { type => 'integer' }, id => { type => '$serial', not_null => 1 }, $set_col last_modified => { type => 'datetime' }, name => { type => 'varchar', @{[ $no_empty_def ? '' : "default => '', " ]}length => 32, not_null => 1 }, save => { type => 'integer', alias => 'save_col' }, start => { type => 'date', default => '1980-12-24' }, status => { type => 'varchar', default => 'active', length => 32 }, ); __PACKAGE__->meta->primary_key_columns([ 'id' ]); __PACKAGE__->meta->allow_inline_column_values(1); __PACKAGE__->meta->foreign_keys( fother => { class => 'MyMySQLOtherObject2', key_columns => { fother_id2 => 'id2' }, }, fother2 => { class => 'MyMySQLOtherObject3', key_columns => { fother_id3 => 'id3' }, }, fother3 => { class => 'MyMySQLOtherObject4', key_columns => { fother_id4 => 'id4' }, }, my_my_sqlother_object => { class => 'MyMySQLOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ); __PACKAGE__->meta->initialize; 1; EOF is(MyMySQLObject->meta->perl_class_definition, <<"EOF", "perl_class_definition (trad) 1 - $db_type"); package MyMySQLObject; use strict; use base qw(Rose::DB::Object); __PACKAGE__->meta->setup( table => 'Rose_db_object_test', columns => [ bits => { type => 'bitfield', bits => 5, default => 101 }, date_created => { type => 'datetime' }, fk1 => { type => 'integer', alias => 'fkone' }, fk2 => { type => 'integer' }, fk3 => { type => 'integer' }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, fother_id2 => { type => 'integer' }, fother_id3 => { type => 'integer' }, fother_id4 => { type => 'integer' }, id => { type => '$serial', not_null => 1 }, $set_col last_modified => { type => 'datetime' }, name => { type => 'varchar', @{[ $no_empty_def ? '' : "default => '', " ]}length => 32, not_null => 1 }, save => { type => 'integer', alias => 'save_col' }, start => { type => 'date', default => '1980-12-24' }, status => { type => 'varchar', default => 'active', length => 32 }, ], primary_key_columns => [ 'id' ], allow_inline_column_values => 1, foreign_keys => [ fother => { class => 'MyMySQLOtherObject2', key_columns => { fother_id2 => 'id2' }, }, fother2 => { class => 'MyMySQLOtherObject3', key_columns => { fother_id3 => 'id3' }, }, fother3 => { class => 'MyMySQLOtherObject4', key_columns => { fother_id4 => 'id4' }, }, my_my_sqlother_object => { class => 'MyMySQLOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ], ); 1; EOF MyMySQLObject->meta->auto_load_related_classes(1); is(MyMySQLObject->meta->perl_class_definition(braces => 'bsd', indent => 2, use_setup => 0), <<"EOF", "perl_class_definition (trad) 2 - $db_type"); package MyMySQLObject; use strict; use base qw(Rose::DB::Object); __PACKAGE__->meta->table('Rose_db_object_test'); __PACKAGE__->meta->columns ( bits => { type => 'bitfield', bits => 5, default => 101 }, date_created => { type => 'datetime' }, fk1 => { type => 'integer', alias => 'fkone' }, fk2 => { type => 'integer' }, fk3 => { type => 'integer' }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, fother_id2 => { type => 'integer' }, fother_id3 => { type => 'integer' }, fother_id4 => { type => 'integer' }, id => { type => '$serial', not_null => 1 }, $set_col last_modified => { type => 'datetime' }, name => { type => 'varchar', @{[ $no_empty_def ? '' : "default => '', " ]}length => 32, not_null => 1 }, save => { type => 'integer', alias => 'save_col' }, start => { type => 'date', default => '1980-12-24' }, status => { type => 'varchar', default => 'active', length => 32 }, ); __PACKAGE__->meta->primary_key_columns([ 'id' ]); __PACKAGE__->meta->allow_inline_column_values(1); __PACKAGE__->meta->foreign_keys ( fother => { class => 'MyMySQLOtherObject2', key_columns => { fother_id2 => 'id2' }, }, fother2 => { class => 'MyMySQLOtherObject3', key_columns => { fother_id3 => 'id3' }, }, fother3 => { class => 'MyMySQLOtherObject4', key_columns => { fother_id4 => 'id4' }, }, my_my_sqlother_object => { class => 'MyMySQLOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ); __PACKAGE__->meta->initialize; 1; EOF } # # Informix # SKIP: foreach my $db_type ('informix') { skip("Informix tests", 65) unless($HAVE_INFORMIX); Rose::DB->default_type($db_type); my $o = MyInformixObject->new(name => 'John', id => 1); ok(ref $o && $o->isa('MyInformixObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(7); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); my $o2 = MyInformixObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyInformixObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 7, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyInformixObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyInformixObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->load, "load() 4 - $db_type"); my $o5 = MyInformixObject->new(id => $o->id); ok($o5->load, "load() 5 - $db_type"); $o5->nums([ 4, 5, 6 ]); ok($o5->save, "save() 4 - $db_type"); ok($o->load, "load() 6 - $db_type"); is($o5->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o5->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o5->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o5->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); my $oo1 = MyInformixOtherObject->new(k1 => 1, k2 => 2, k3 => 3, name => 'one'); ok($oo1->save, 'other object save() 1'); my $oo2 = MyInformixOtherObject->new(k1 => 11, k2 => 12, k3 => 13, name => 'two'); ok($oo2->save, 'other object save() 2'); my $other2 = MyInformixOtherObject2->new(id2 => 12, name => 'twelve'); ok($other2->save, 'other 2 object save() 1'); my $other3 = MyInformixOtherObject3->new(id3 => 13, name => 'thirteen'); ok($other3->save, 'other 3 object save() 1'); my $other4 = MyInformixOtherObject4->new(id4 => 14, name => 'fourteen'); ok($other4->save, 'other 4 object save() 1'); is($o->fother, undef, 'fother() 1'); is($o->fother2, undef, 'fother2() 1'); is($o->fother3, undef, 'fother3() 1'); is($o->my_informix_other_object, undef, 'my_informix_other_object() 1'); $o->fother_id2(12); $o->fother_id3(13); $o->fother_id4(14); $o->fkone(1); $o->fk2(2); $o->fk3(3); my $obj = $o->my_informix_other_object or warn "# ", $o->error, "\n"; is(ref $obj, 'MyInformixOtherObject', 'my_informix_other_object() 2'); is($obj->name, 'one', 'my_informix_other_object() 3'); $obj = $o->fother or warn "# ", $o->error, "\n"; is(ref $obj, 'MyInformixOtherObject2', 'fother() 2'); is($obj->name, 'twelve', 'fother() 3'); $obj = $o->fother2 or warn "# ", $o->error, "\n"; is(ref $obj, 'MyInformixOtherObject3', 'fother2() 2'); is($obj->name, 'thirteen', 'fother2() 3'); $obj = $o->fother3 or warn "# ", $o->error, "\n"; is(ref $obj, 'MyInformixOtherObject4', 'fother3() 2'); is($obj->name, 'fourteen', 'fother3() 3'); $o->my_informix_other_object(undef); $o->fkone(11); $o->fk2(12); $o->fk3(13); $obj = $o->my_informix_other_object or warn "# ", $o->error, "\n"; is(ref $obj, 'MyInformixOtherObject', 'my_informix_other_object() 4'); is($obj->name, 'two', 'my_informix_other_object() 5'); ok($o->delete, "delete() - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, 'alias_column() nonesuch'); # # Test code generation # is(MyInformixObject->meta->perl_foreign_keys_definition, <<'EOF', "perl_foreign_keys_definition 1 - $db_type"); __PACKAGE__->meta->foreign_keys( fother => { class => 'MyInformixOtherObject2', key_columns => { fother_id2 => 'id2' }, }, fother2 => { class => 'MyInformixOtherObject3', key_columns => { fother_id3 => 'id3' }, }, fother3 => { class => 'MyInformixOtherObject4', key_columns => { fother_id4 => 'id4' }, }, my_informix_other_object => { class => 'MyInformixOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ); EOF is(MyInformixObject->meta->perl_foreign_keys_definition(braces => 'bsd', indent => 2), <<'EOF', "perl_foreign_keys_definition 2 - $db_type"); __PACKAGE__->meta->foreign_keys ( fother => { class => 'MyInformixOtherObject2', key_columns => { fother_id2 => 'id2' }, }, fother2 => { class => 'MyInformixOtherObject3', key_columns => { fother_id3 => 'id3' }, }, fother3 => { class => 'MyInformixOtherObject4', key_columns => { fother_id4 => 'id4' }, }, my_informix_other_object => { class => 'MyInformixOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ); EOF is(MyInformixObject->meta->perl_class_definition(use_setup => 0), <<'EOF', "perl_class_definition (trad) 1 - $db_type"); package MyInformixObject; use strict; use base qw(Rose::DB::Object); __PACKAGE__->meta->table('Rose_db_object_test'); __PACKAGE__->meta->columns( bits => { type => 'bitfield', bits => 5, default => 101 }, date_created => { type => 'datetime year to fraction(5)' }, fk1 => { type => 'integer', alias => 'fkone' }, fk2 => { type => 'integer' }, fk3 => { type => 'integer' }, flag => { type => 'boolean', default => 't', not_null => 1 }, flag2 => { type => 'boolean' }, fother_id2 => { type => 'integer' }, fother_id3 => { type => 'integer' }, fother_id4 => { type => 'integer' }, id => { type => 'integer', not_null => 1 }, last_modified => { type => 'datetime year to fraction(5)' }, name => { type => 'varchar', length => 32, not_null => 1 }, nums => { type => 'array' }, save => { type => 'integer', alias => 'save_col' }, start => { type => 'date', default => '12/24/1980' }, status => { type => 'varchar', default => 'active', length => 32 }, ); __PACKAGE__->meta->primary_key_columns([ 'id' ]); __PACKAGE__->meta->foreign_keys( fother => { class => 'MyInformixOtherObject2', key_columns => { fother_id2 => 'id2' }, }, fother2 => { class => 'MyInformixOtherObject3', key_columns => { fother_id3 => 'id3' }, }, fother3 => { class => 'MyInformixOtherObject4', key_columns => { fother_id4 => 'id4' }, }, my_informix_other_object => { class => 'MyInformixOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ); __PACKAGE__->meta->initialize; 1; EOF MyInformixObject->meta->auto_load_related_classes(1); is(MyInformixObject->meta->perl_class_definition(braces => 'bsd', indent => 2, use_setup => 0), <<'EOF', "perl_class_definition (trad) 2 - $db_type"); package MyInformixObject; use strict; use base qw(Rose::DB::Object); __PACKAGE__->meta->table('Rose_db_object_test'); __PACKAGE__->meta->columns ( bits => { type => 'bitfield', bits => 5, default => 101 }, date_created => { type => 'datetime year to fraction(5)' }, fk1 => { type => 'integer', alias => 'fkone' }, fk2 => { type => 'integer' }, fk3 => { type => 'integer' }, flag => { type => 'boolean', default => 't', not_null => 1 }, flag2 => { type => 'boolean' }, fother_id2 => { type => 'integer' }, fother_id3 => { type => 'integer' }, fother_id4 => { type => 'integer' }, id => { type => 'integer', not_null => 1 }, last_modified => { type => 'datetime year to fraction(5)' }, name => { type => 'varchar', length => 32, not_null => 1 }, nums => { type => 'array' }, save => { type => 'integer', alias => 'save_col' }, start => { type => 'date', default => '12/24/1980' }, status => { type => 'varchar', default => 'active', length => 32 }, ); __PACKAGE__->meta->primary_key_columns([ 'id' ]); __PACKAGE__->meta->foreign_keys ( fother => { class => 'MyInformixOtherObject2', key_columns => { fother_id2 => 'id2' }, }, fother2 => { class => 'MyInformixOtherObject3', key_columns => { fother_id3 => 'id3' }, }, fother3 => { class => 'MyInformixOtherObject4', key_columns => { fother_id4 => 'id4' }, }, my_informix_other_object => { class => 'MyInformixOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ); __PACKAGE__->meta->initialize; 1; EOF } # # SQLite # SKIP: foreach my $db_type ('sqlite') { skip("SQLite tests", 67) unless($HAVE_SQLITE); Rose::DB->default_type($db_type); my $i = 1; foreach my $name (qw(id name flag flag2 status bits start save fk1 fk2 fk3 fother_id2 fother_id3 fother_id4 last_modified date_created nums)) { MySQLiteObject->meta->column($name)->ordinal_position($i++); } my $o = MySQLiteObject->new(name => 'John', eyedee => 1); ok(ref $o && $o->isa('MySQLiteObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(7); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); my $o2 = MySQLiteObject->new(eyedee => $o->eyedee); ok(ref $o2 && $o2->isa('MySQLiteObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 7, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MySQLiteObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MySQLiteObject->new(eyedee => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->load, "load() 4 - $db_type"); my $o5 = MySQLiteObject->new(eyedee => $o->eyedee); ok($o5->load, "load() 5 - $db_type"); $o5->nums([ 4, 5, 6 ]); ok($o5->save, "save() 4 - $db_type"); ok($o->load, "load() 6 - $db_type"); is($o5->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o5->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o5->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o5->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); my $oo1 = MySQLiteOtherObject->new(k1 => 1, k2 => 2, k3 => 3, name => 'one'); ok($oo1->save, 'other object save() 1'); my $oo2 = MySQLiteOtherObject->new(k1 => 11, k2 => 12, k3 => 13, name => 'two'); ok($oo2->save, 'other object save() 2'); my $other2 = MySQLiteOtherObject2->new(id2 => 12, name => 'twelve'); ok($other2->save, 'other 2 object save() 1'); my $other3 = MySQLiteOtherObject3->new(id3 => 13, name => 'thirteen'); ok($other3->save, 'other 3 object save() 1'); my $other4 = MySQLiteOtherObject4->new(id4 => 14, name => 'fourteen'); ok($other4->save, 'other 4 object save() 1'); is($o->fother, undef, 'fother() 1'); is($o->fother2, undef, 'fother2() 1'); is($o->fother3, undef, 'fother3() 1'); is($o->my_sqlite_other_object, undef, 'my_sqlite_other_object() 1'); $o->fother_id2(12); $o->fother_id3(13); $o->fother_id4(14); $o->fkone(1); $o->fk2(2); $o->fk3(3); my $obj = $o->my_sqlite_other_object or warn "# ", $o->error, "\n"; is(ref $obj, 'MySQLiteOtherObject', 'my_sqlite_other_object() 2'); is($obj->name, 'one', 'my_sqlite_other_object() 3'); $obj = $o->fother or warn "# ", $o->error, "\n"; is(ref $obj, 'MySQLiteOtherObject2', 'fother() 2'); is($obj->name, 'twelve', 'fother() 3'); $obj = $o->fother2 or warn "# ", $o->error, "\n"; is(ref $obj, 'MySQLiteOtherObject3', 'fother2() 2'); is($obj->name, 'thirteen', 'fother2() 3'); $obj = $o->fother3 or warn "# ", $o->error, "\n"; is(ref $obj, 'MySQLiteOtherObject4', 'fother3() 2'); is($obj->name, 'fourteen', 'fother3() 3'); $o->my_sqlite_other_object(undef); $o->fkone(11); $o->fk2(12); $o->fk3(13); $obj = $o->my_sqlite_other_object or warn "# ", $o->error, "\n"; is(ref $obj, 'MySQLiteOtherObject', 'my_sqlite_other_object() 4'); is($obj->name, 'two', 'my_sqlite_other_object() 5'); ok($o->delete, "delete() - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, 'alias_column() nonesuch'); # # Test code generation # is(MySQLiteObject->meta->perl_foreign_keys_definition, <<'EOF', "perl_foreign_keys_definition 1 - $db_type"); __PACKAGE__->meta->foreign_keys( fother => { class => 'MySQLiteOtherObject2', key_columns => { fother_id2 => 'id2' }, }, fother2 => { class => 'MySQLiteOtherObject3', key_columns => { fother_id3 => 'id3' }, }, fother3 => { class => 'MySQLiteOtherObject4', key_columns => { fother_id4 => 'id4' }, }, my_sqlite_other_object => { class => 'MySQLiteOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ); EOF is(MySQLiteObject->meta->perl_foreign_keys_definition(braces => 'bsd', indent => 2), <<'EOF', "perl_foreign_keys_definition 2 - $db_type"); __PACKAGE__->meta->foreign_keys ( fother => { class => 'MySQLiteOtherObject2', key_columns => { fother_id2 => 'id2' }, }, fother2 => { class => 'MySQLiteOtherObject3', key_columns => { fother_id3 => 'id3' }, }, fother3 => { class => 'MySQLiteOtherObject4', key_columns => { fother_id4 => 'id4' }, }, my_sqlite_other_object => { class => 'MySQLiteOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ); EOF is(MySQLiteObject->meta->perl_class_definition(use_setup => 0), <<'EOF', "perl_class_definition (trad) 1 - $db_type"); package MySQLiteObject; use strict; use base qw(Rose::DB::Object); __PACKAGE__->meta->table('Rose_db_object_test'); __PACKAGE__->meta->columns( id => { type => 'integer', alias => 'eyedee', not_null => 1 }, name => { type => 'varchar', length => 32, not_null => 1 }, flag => { type => 'boolean', default => 't', not_null => 1 }, flag2 => { type => 'boolean' }, status => { type => 'varchar', default => 'active', length => 32 }, bits => { type => 'bitfield', bits => 5, default => '00101', not_null => 1 }, start => { type => 'date', default => '1980-12-24' }, save => { type => 'integer', alias => 'save_col' }, fk1 => { type => 'integer', alias => 'fkone' }, fk2 => { type => 'integer' }, fk3 => { type => 'integer' }, fother_id2 => { type => 'integer' }, fother_id3 => { type => 'integer' }, fother_id4 => { type => 'integer' }, last_modified => { type => 'datetime' }, date_created => { type => 'datetime' }, nums => { type => 'array' }, ); __PACKAGE__->meta->primary_key_columns([ 'id' ]); __PACKAGE__->meta->foreign_keys( fother => { class => 'MySQLiteOtherObject2', key_columns => { fother_id2 => 'id2' }, }, fother2 => { class => 'MySQLiteOtherObject3', key_columns => { fother_id3 => 'id3' }, }, fother3 => { class => 'MySQLiteOtherObject4', key_columns => { fother_id4 => 'id4' }, }, my_sqlite_other_object => { class => 'MySQLiteOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ); __PACKAGE__->meta->initialize; 1; EOF is(MySQLiteObject->meta->perl_class_definition, <<'EOF', "perl_class_definition 1 - $db_type"); package MySQLiteObject; use strict; use base qw(Rose::DB::Object); __PACKAGE__->meta->setup( table => 'Rose_db_object_test', columns => [ id => { type => 'integer', alias => 'eyedee', not_null => 1 }, name => { type => 'varchar', length => 32, not_null => 1 }, flag => { type => 'boolean', default => 't', not_null => 1 }, flag2 => { type => 'boolean' }, status => { type => 'varchar', default => 'active', length => 32 }, bits => { type => 'bitfield', bits => 5, default => '00101', not_null => 1 }, start => { type => 'date', default => '1980-12-24' }, save => { type => 'integer', alias => 'save_col' }, fk1 => { type => 'integer', alias => 'fkone' }, fk2 => { type => 'integer' }, fk3 => { type => 'integer' }, fother_id2 => { type => 'integer' }, fother_id3 => { type => 'integer' }, fother_id4 => { type => 'integer' }, last_modified => { type => 'datetime' }, date_created => { type => 'datetime' }, nums => { type => 'array' }, ], primary_key_columns => [ 'id' ], foreign_keys => [ fother => { class => 'MySQLiteOtherObject2', key_columns => { fother_id2 => 'id2' }, }, fother2 => { class => 'MySQLiteOtherObject3', key_columns => { fother_id3 => 'id3' }, }, fother3 => { class => 'MySQLiteOtherObject4', key_columns => { fother_id4 => 'id4' }, }, my_sqlite_other_object => { class => 'MySQLiteOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ], ); 1; EOF MySQLiteObject->meta->auto_load_related_classes(0); is(MySQLiteObject->meta->perl_class_definition(braces => 'bsd', indent => 2, use_setup => 0), <<'EOF', "perl_class_definition (trad) 2 - $db_type"); package MySQLiteObject; use strict; use base qw(Rose::DB::Object); use MySQLiteOtherObject; use MySQLiteOtherObject2; use MySQLiteOtherObject3; use MySQLiteOtherObject4; __PACKAGE__->meta->table('Rose_db_object_test'); __PACKAGE__->meta->columns ( id => { type => 'integer', alias => 'eyedee', not_null => 1 }, name => { type => 'varchar', length => 32, not_null => 1 }, flag => { type => 'boolean', default => 't', not_null => 1 }, flag2 => { type => 'boolean' }, status => { type => 'varchar', default => 'active', length => 32 }, bits => { type => 'bitfield', bits => 5, default => '00101', not_null => 1 }, start => { type => 'date', default => '1980-12-24' }, save => { type => 'integer', alias => 'save_col' }, fk1 => { type => 'integer', alias => 'fkone' }, fk2 => { type => 'integer' }, fk3 => { type => 'integer' }, fother_id2 => { type => 'integer' }, fother_id3 => { type => 'integer' }, fother_id4 => { type => 'integer' }, last_modified => { type => 'datetime' }, date_created => { type => 'datetime' }, nums => { type => 'array' }, ); __PACKAGE__->meta->primary_key_columns([ 'id' ]); __PACKAGE__->meta->foreign_keys ( fother => { class => 'MySQLiteOtherObject2', key_columns => { fother_id2 => 'id2' }, }, fother2 => { class => 'MySQLiteOtherObject3', key_columns => { fother_id3 => 'id3' }, }, fother3 => { class => 'MySQLiteOtherObject4', key_columns => { fother_id4 => 'id4' }, }, my_sqlite_other_object => { class => 'MySQLiteOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ); __PACKAGE__->meta->initialize; 1; EOF MySQLiteObject->meta->auto_load_related_classes(1); is(MySQLiteObject->meta->perl_class_definition, <<'EOF', "perl_class_definition 2 - $db_type"); package MySQLiteObject; use strict; use base qw(Rose::DB::Object); __PACKAGE__->meta->setup( table => 'Rose_db_object_test', columns => [ id => { type => 'integer', alias => 'eyedee', not_null => 1 }, name => { type => 'varchar', length => 32, not_null => 1 }, flag => { type => 'boolean', default => 't', not_null => 1 }, flag2 => { type => 'boolean' }, status => { type => 'varchar', default => 'active', length => 32 }, bits => { type => 'bitfield', bits => 5, default => '00101', not_null => 1 }, start => { type => 'date', default => '1980-12-24' }, save => { type => 'integer', alias => 'save_col' }, fk1 => { type => 'integer', alias => 'fkone' }, fk2 => { type => 'integer' }, fk3 => { type => 'integer' }, fother_id2 => { type => 'integer' }, fother_id3 => { type => 'integer' }, fother_id4 => { type => 'integer' }, last_modified => { type => 'datetime' }, date_created => { type => 'datetime' }, nums => { type => 'array' }, ], primary_key_columns => [ 'id' ], foreign_keys => [ fother => { class => 'MySQLiteOtherObject2', key_columns => { fother_id2 => 'id2' }, }, fother2 => { class => 'MySQLiteOtherObject3', key_columns => { fother_id3 => 'id3' }, }, fother3 => { class => 'MySQLiteOtherObject4', key_columns => { fother_id4 => 'id4' }, }, my_sqlite_other_object => { class => 'MySQLiteOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ], ); 1; EOF } BEGIN { # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_PG = 1; Rose::DB::Object::Metadata->unregister_all_classes; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_other'); $dbh->do('DROP TABLE Rose_db_object_other2'); $dbh->do('DROP TABLE Rose_db_object_other3'); $dbh->do('DROP TABLE Rose_db_object_other4'); $dbh->do('DROP TABLE Rose_db_object_chkpass_test'); } our $PG_HAS_CHKPASS = pg_has_chkpass(); $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_other ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32), PRIMARY KEY(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_other2 ( id2 SERIAL PRIMARY KEY, name VARCHAR(32) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_other3 ( id3 SERIAL PRIMARY KEY, name VARCHAR(32) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_other4 ( id4 SERIAL PRIMARY KEY, name VARCHAR(32) ) EOF # Create test foreign subclass 1 package MyPgOtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } MyPgOtherObject->meta->table('Rose_db_object_other'); MyPgOtherObject->meta->auto_initialize; # Create test foreign subclasses 2-4 package MyPgOtherObject2; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } MyPgOtherObject2->meta->table('Rose_db_object_other2'); MyPgOtherObject2->meta->auto_initialize; package MyPgOtherObject3; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } MyPgOtherObject3->meta->table('Rose_db_object_other3'); MyPgOtherObject3->meta->auto_initialize; package MyPgOtherObject4; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } MyPgOtherObject4->meta->table('Rose_db_object_other4'); MyPgOtherObject4->meta->auto_initialize; $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_test ( id SERIAL PRIMARY KEY, @{[ $PG_HAS_CHKPASS ? 'password CHKPASS,' : '' ]} name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL DEFAULT 't', flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits BIT(5) NOT NULL DEFAULT B'00101', start DATE DEFAULT '1980-12-24', save INT, nums INT[], fk1 INT, fk2 INT, fk3 INT, fother_id2 INT REFERENCES Rose_db_object_other2 (id2), fother_id3 INT REFERENCES Rose_db_object_other3 (id3), fother_id4 INT REFERENCES Rose_db_object_other4 (id4), last_modified TIMESTAMP, date_created TIMESTAMP, FOREIGN KEY (fk1, fk2, fk3) REFERENCES Rose_db_object_other (k1, k2, k3) ) EOF $dbh->disconnect; # Create test subclass package MyPgObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } MyPgObject->meta->table('Rose_db_object_test'); MyPgObject->meta->convention_manager(undef); MyPgObject->meta->column_name_to_method_name_mapper(sub { return ($_ eq 'fk1') ? 'fkone' : $_ }); MyPgObject->meta->auto_initialize; Test::More::ok(MyPgObject->can('fother'), 'fother() check - pg'); Test::More::ok(MyPgObject->can('fother2'), 'fother2() check - pg'); Test::More::ok(MyPgObject->can('fother3'), 'fother3() check - pg'); package MyPgObjectEvalTest; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } eval 'package MyPgObjectEvalTest; ' . MyPgObject->meta->perl_foreign_keys_definition; Test::More::ok(!$@, 'perl_foreign_keys_definition eval - pg'); } # # MySQL # my $db_version; eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; $db_version = $db->database_version; die "MySQL version too old" unless($db_version >= 4_000_000); CLEAR: { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_other'); } # Foreign key stuff requires InnoDB support $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_other ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32), PRIMARY KEY(k1, k2, k3) ) ENGINE=InnoDB EOF # MySQL will silently ignore the "ENGINE=InnoDB" part and create # a MyISAM table instead. MySQL is evil! Now we have to manually # check to make sure an InnoDB table was really created. my $db_name = $db->database; my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?"); $sth->execute('Rose_db_object_other'); my $info = $sth->fetchrow_hashref; no warnings 'uninitialized'; unless(lc $info->{'Type'} eq 'innodb' || lc $info->{'Engine'} eq 'innodb') { die "Missing InnoDB support"; } }; if(!$@ && $dbh) { our $HAVE_MYSQL_WITH_INNODB = 1; Rose::DB::Object::Metadata->unregister_all_classes; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_other'); $dbh->do('DROP TABLE Rose_db_object_other2'); $dbh->do('DROP TABLE Rose_db_object_other3'); $dbh->do('DROP TABLE Rose_db_object_other4'); } $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_other ( k1 INT UNSIGNED NOT NULL, k2 INT UNSIGNED NOT NULL, k3 INT UNSIGNED NOT NULL, name VARCHAR(32), PRIMARY KEY(k1, k2, k3) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_other2 ( id2 INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, name VARCHAR(32) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_other3 ( id3 INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, name VARCHAR(32) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_other4 ( id4 INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, name VARCHAR(32) ) ENGINE=InnoDB EOF # Create test foreign subclass 1 package MyMySQLOtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } MyMySQLOtherObject->meta->table('Rose_db_object_other'); MyMySQLOtherObject->meta->auto_initialize; # Create test foreign subclasses 2-4 package MyMySQLOtherObject2; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } MyMySQLOtherObject2->meta->table('Rose_db_object_other2'); MyMySQLOtherObject2->meta->auto_initialize; package MyMySQLOtherObject3; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } MyMySQLOtherObject3->meta->table('Rose_db_object_other3'); MyMySQLOtherObject3->meta->auto_initialize; package MyMySQLOtherObject4; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } MyMySQLOtherObject4->meta->table('Rose_db_object_other4'); MyMySQLOtherObject4->meta->auto_initialize; # MySQL 5.0.3 or later has a completely stupid "native" BIT type # which we want to avoid because DBI's column_info() method prints # a warning when it encounters such a column. my $bit_col = ($db_version >= 5_000_003) ? q(bits TINYINT(1) NOT NULL DEFAULT '00101') : q(bits BIT(5) NOT NULL DEFAULT '00101'); my $set_col = ($db_version >= 5_000_000) ? q(items SET('a','b','c') NOT NULL DEFAULT 'a,c') : q(items VARCHAR(255) NOT NULL DEFAULT 'a,c'); $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_test ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(32) NOT NULL, flag TINYINT(1) NOT NULL, flag2 TINYINT(1), status VARCHAR(32) DEFAULT 'active', $bit_col, $set_col, start DATE DEFAULT '1980-12-24', save INT, fk1 INT UNSIGNED, fk2 INT UNSIGNED, fk3 INT UNSIGNED, fother_id2 INT UNSIGNED, fother_id3 INT UNSIGNED, fother_id4 INT UNSIGNED, last_modified DATETIME, date_created DATETIME, INDEX(fother_id2), INDEX(fother_id3), INDEX(fother_id4), INDEX(fk1, fk2, fk3), FOREIGN KEY (fother_id2) REFERENCES Rose_db_object_other2 (id2) ON DELETE NO ACTION ON UPDATE SET NULL, FOREIGN KEY (fother_id3) REFERENCES Rose_db_object_other3 (id3) ON UPDATE NO ACTION ON DELETE CASCADE, FOREIGN KEY (fother_id4) REFERENCES Rose_db_object_other4 (id4) ON DELETE CASCADE ON UPDATE SET NULL, FOREIGN KEY (fk1, fk2, fk3) REFERENCES Rose_db_object_other (k1, k2, k3) ) ENGINE=InnoDB COMMENT='This is a very long comment. This is a very long comment.' EOF $dbh->disconnect; # Create test subclass package MyMySQLObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } MyMySQLObject->meta->allow_inline_column_values(1); MyMySQLObject->meta->table('Rose_db_object_test'); MyMySQLObject->meta->convention_manager(undef); MyMySQLObject->meta->column_name_to_method_name_mapper(sub { return ($_ eq 'fk1') ? 'fkone' : $_ }); MyMySQLObject->meta->auto_init_columns; # Account for bugs in DBD::mysql's column_info implementation # BIT(5) column shows up as TINYINT(1) MyMySQLObject->meta->column(bits => { type => 'bitfield', bits => 5, default => 101 }); # BOOLEAN column shows up as TINYINT(1) even if you use the # BOOLEAN keyword (which is not supported prior to MySQL 4.1, # so we're actually using TINYINT(1) in the definition above) MyMySQLObject->meta->column(flag => { type => 'boolean', default => 1 }); MyMySQLObject->meta->column(flag2 => { type => 'boolean' }); MyMySQLObject->meta->auto_initialize; Test::More::ok(MyMySQLObject->can('fother'), 'fother() check - mysql'); Test::More::ok(MyMySQLObject->can('fother2'), 'fother2() check - mysql'); Test::More::ok(MyMySQLObject->can('fother3'), 'fother3() check - mysql'); package MyMySQLObjectEvalTest; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } eval 'package MyMySQLObjectEvalTest; ' . MyMySQLObject->meta->perl_foreign_keys_definition; Test::More::ok(!$@, 'perl_foreign_keys_definition eval - mysql'); } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_INFORMIX = 1; Rose::DB::Object::Metadata->unregister_all_classes; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_test'); $dbh->do('DROP TABLE Rose_db_object_other'); $dbh->do('DROP TABLE Rose_db_object_other2'); $dbh->do('DROP TABLE Rose_db_object_other3'); $dbh->do('DROP TABLE Rose_db_object_other4'); } $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_other ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32), PRIMARY KEY(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_other2 ( id2 SERIAL PRIMARY KEY, name VARCHAR(32) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_other3 ( id3 SERIAL PRIMARY KEY, name VARCHAR(32) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_other4 ( id4 SERIAL PRIMARY KEY, name VARCHAR(32) ) EOF # Create test foreign subclass 1 package MyInformixOtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('informix') } MyInformixOtherObject->meta->table('Rose_db_object_other'); MyInformixOtherObject->meta->auto_initialize; # Create test foreign subclasses 2-4 package MyInformixOtherObject2; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('informix') } MyInformixOtherObject2->meta->table('Rose_db_object_other2'); MyInformixOtherObject2->meta->auto_initialize; package MyInformixOtherObject3; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('informix') } MyInformixOtherObject3->meta->table('Rose_db_object_other3'); MyInformixOtherObject3->meta->auto_initialize; package MyInformixOtherObject4; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('informix') } MyInformixOtherObject4->meta->table('Rose_db_object_other4'); MyInformixOtherObject4->meta->auto_initialize; $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_test ( id INT NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, flag BOOLEAN DEFAULT 't' NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits VARCHAR(5) DEFAULT '00101' NOT NULL, start DATE DEFAULT '12/24/1980', save INT, nums VARCHAR(255), fk1 INT, fk2 INT, fk3 INT, fother_id2 INT REFERENCES Rose_db_object_other2 (id2), fother_id3 INT REFERENCES Rose_db_object_other3 (id3), fother_id4 INT REFERENCES Rose_db_object_other4 (id4), last_modified DATETIME YEAR TO FRACTION(5), date_created DATETIME YEAR TO FRACTION(5), FOREIGN KEY (fk1, fk2, fk3) REFERENCES Rose_db_object_other (k1, k2, k3) ) EOF $dbh->disconnect; # Create test subclass package MyInformixObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('informix') } MyInformixObject->meta->table('Rose_db_object_test'); MyInformixObject->meta->convention_manager(undef); MyInformixObject->meta->column_name_to_method_name_mapper(sub { return ($_ eq 'fk1') ? 'fkone' : $_ }); # No native support for bit types in Informix MyInformixObject->meta->column(bits => { type => 'bitfield', bits => 5, default => 101 }); # No native support for array types in Informix MyInformixObject->meta->column(nums => { type => 'array' }); MyInformixObject->meta->auto_initialize; Test::More::ok(MyInformixObject->can('fother'), 'fother() check - informix'); Test::More::ok(MyInformixObject->can('fother2'), 'fother2() check - informix'); Test::More::ok(MyInformixObject->can('fother3'), 'fother3() check - informix'); package MyInformixObjectEvalTest; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('informix') } eval 'package MyInformixObjectEvalTest; ' . MyInformixObject->meta->perl_foreign_keys_definition; Test::More::ok(!$@, 'perl_foreign_keys_definition eval - informix'); } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_SQLITE = 1; Rose::DB::Object::Metadata->unregister_all_classes; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_test'); $dbh->do('DROP TABLE Rose_db_object_other'); $dbh->do('DROP TABLE Rose_db_object_other2'); $dbh->do('DROP TABLE Rose_db_object_other3'); $dbh->do('DROP TABLE Rose_db_object_other4'); } $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_other ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32), PRIMARY KEY(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_other2 ( id2 INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(32) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_other3 ( id3 INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(32) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_other4 ( id4 INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(32) ) EOF # Create test foreign subclass 1 package MySQLiteOtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MySQLiteOtherObject->meta->table('Rose_db_object_other'); MySQLiteOtherObject->meta->auto_initialize; # Create test foreign subclasses 2-4 package MySQLiteOtherObject2; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MySQLiteOtherObject2->meta->table('Rose_db_object_other2'); MySQLiteOtherObject2->meta->auto_initialize; package MySQLiteOtherObject3; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MySQLiteOtherObject3->meta->table('Rose_db_object_other3'); MySQLiteOtherObject3->meta->auto_initialize; package MySQLiteOtherObject4; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MySQLiteOtherObject4->meta->table('Rose_db_object_other4'); MySQLiteOtherObject4->meta->auto_initialize; $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_test ( id INT NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, flag BOOLEAN DEFAULT 't' NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits BIT(5) DEFAULT '00101' NOT NULL, start DATE DEFAULT '1980-12-24', save INT, nums VARCHAR(255), fk1 INT, fk2 INT, fk3 INT, fother_id2 INT REFERENCES Rose_db_object_other2 (id2), fother_id3 INT REFERENCES Rose_db_object_other3 (id3), fother_id4 INT REFERENCES Rose_db_object_other4 (id4), last_modified DATETIME, date_created DATETIME, FOREIGN KEY (fk1, fk2, fk3) REFERENCES Rose_db_object_other (k1, k2, k3) ) EOF $dbh->disconnect; # Create test subclass package MyAutoSQLite; use base 'Rose::DB::Object::Metadata::Auto::SQLite'; sub auto_alias_columns { my($self) = shift; foreach my $column (@_) { if($column->name eq 'fk1') { $column->alias('fkone') } elsif($column->name eq 'save') { $column->alias('save_col') } elsif($column->name eq 'id') { $column->alias('eyedee') } } } Rose::DB::Object::Metadata->auto_helper_class(sqlite => 'MyAutoSQLite'); package MySQLiteObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MySQLiteObject->meta->table('Rose_db_object_test'); MySQLiteObject->meta->convention_manager(undef); #MySQLiteObject->meta->column_name_to_method_name_mapper(sub #{ # return ($_ eq 'fk1') ? 'fkone' : $_ #}); MySQLiteObject->meta->auto_initialize; # No native support for array types in SQLite MySQLiteObject->meta->delete_column('nums'); MySQLiteObject->meta->add_column(nums => { type => 'array' }); MySQLiteObject->meta->make_column_methods(replace_existing => 1); Test::More::ok(MySQLiteObject->can('fother'), 'fother() check - sqlite'); Test::More::ok(MySQLiteObject->can('fother2'), 'fother2() check - sqlite'); Test::More::ok(MySQLiteObject->can('fother3'), 'fother3() check - sqlite'); package MySQLiteObjectEvalTest; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } eval 'package MySQLiteObjectEvalTest; ' . MySQLiteObject->meta->perl_foreign_keys_definition; Test::More::ok(!$@, 'perl_foreign_keys_definition eval - sqlite'); } } END { # Delete test table if($HAVE_PG) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_other'); $dbh->do('DROP TABLE Rose_db_object_other2'); $dbh->do('DROP TABLE Rose_db_object_other3'); $dbh->do('DROP TABLE Rose_db_object_other4'); $dbh->disconnect; } if($HAVE_MYSQL_WITH_INNODB) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_other'); $dbh->do('DROP TABLE Rose_db_object_other2'); $dbh->do('DROP TABLE Rose_db_object_other3'); $dbh->do('DROP TABLE Rose_db_object_other4'); $dbh->disconnect; } if($HAVE_INFORMIX) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_other'); $dbh->do('DROP TABLE Rose_db_object_other2'); $dbh->disconnect; } if($HAVE_SQLITE) { # SQLite my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_test'); $dbh->do('DROP TABLE Rose_db_object_other'); $dbh->do('DROP TABLE Rose_db_object_other2'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-foreign-key.t000755 000765 000120 00000105705 12054157213 020715 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 199; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); } our($PG_HAS_CHKPASS, $HAVE_PG, $HAVE_MYSQL, $HAVE_INFORMIX, $HAVE_SQLITE); # # PostgreSQL # SKIP: foreach my $db_type ('pg') { skip("PostgreSQL tests", 60) unless($HAVE_PG); Rose::DB->default_type($db_type); my $o = MyPgObject->new(name => 'John'); ok(ref $o && $o->isa('MyPgObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(7); $o->other2_obj(7); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); is($o->other2_obj->name, 'def', "single column foreign key 1 - $db_type"); my $old_fks = $o->fks; $o->other2_obj(undef); $o->fks(0); eval { $o->other2_obj }; ok($@, "fatal referential_integrity - $db_type"); ok(!defined $o->other2_obj_soft, "ok referential_integrity - $db_type"); $o->fks($old_fks); my $o2 = MyPgObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyPgObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 7, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); $o2->other2_obj({ id => 3, name => 'foo' }); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->other2_obj->name, 'foo', "single column foreign key 2 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyPgObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyPgObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); $o->other2_obj(MyPgOtherObject2->new(name => 'bar')); $o->save; $o = MyPgObject->new(id => $o->id)->load; is($o->other2_obj->name, 'bar', "single column foreign key 3 - $db_type"); ok($o->load, "load() 4 - $db_type"); SKIP: { if($PG_HAS_CHKPASS) { $o->{'password_encrypted'} = ':8R1Kf2nOS0bRE'; ok($o->password_is('xyzzy'), "chkpass() 1 - $db_type"); is($o->password, 'xyzzy', "chkpass() 2 - $db_type"); $o->password('foobar'); ok($o->password_is('foobar'), "chkpass() 3 - $db_type"); is($o->password, 'foobar', "chkpass() 4 - $db_type"); ok($o->save, "save() 3 - $db_type"); } else { skip("chkpass tests", 5); } } my $o5 = MyPgObject->new(id => $o->id); ok($o5->load, "load() 5 - $db_type"); SKIP: { if($PG_HAS_CHKPASS) { ok($o5->password_is('foobar'), "chkpass() 5 - $db_type"); is($o5->password, 'foobar', "chkpass() 6 - $db_type"); } else { skip("chkpass tests", 2); } } $o5->nums([ 4, 5, 6 ]); ok($o5->save, "save() 4 - $db_type"); ok($o->load, "load() 6 - $db_type"); is($o5->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o5->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o5->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o5->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); my $oo1 = MyPgOtherObject->new(k1 => 1, k2 => 2, k3 => 3, name => 'one'); ok($oo1->save, 'other object save() 1'); my $oo2 = MyPgOtherObject->new(k1 => 11, k2 => 12, k3 => 13, name => 'two'); ok($oo2->save, 'other object save() 2'); is($o->other_obj, undef, 'other_obj() 1'); $o->fkone(1); $o->fk2(2); $o->fk3(3); my $obj = $o->other_obj or warn "# ", $o->error, "\n"; is(ref $obj, 'MyPgOtherObject', 'other_obj() 2'); is($obj->name, 'one', 'other_obj() 3'); is($obj->db, $o->db, 'share_db (default true)'); $o->other_obj(undef); $o->fkone(11); $o->fk2(12); $o->fk3(13); $obj = $o->other_obj or warn "# ", $o->error, "\n"; is(ref $obj, 'MyPgOtherObject', 'other_obj() 4'); is($obj->name, 'two', 'other_obj() 5'); $o->fk2(undef); is($o->other_obj, undef, "key_column_triggers - $db_type"); ok($o->delete, "delete() - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, 'alias_column() nonesuch'); } # # MySQL # SKIP: foreach my $db_type ('mysql') { skip("MySQL tests", 34) unless($HAVE_MYSQL); Rose::DB->default_type($db_type); my $o = MyMySQLObject->new(name => 'John'); ok(ref $o && $o->isa('MyMySQLObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(22); $o->other2_obj(7); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); is($o->other2_obj->name, 'def', "single column foreign key 1 - $db_type"); my $old_fks = $o->fks; $o->other2_obj(undef); $o->fks(0); eval { $o->other2_obj }; ok($@, "fatal referential_integrity - $db_type"); ok(!defined $o->other2_obj_soft, "ok referential_integrity - $db_type"); $o->fks($old_fks); my $o2 = MyMySQLObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyMySQLObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load(with => [ 'other_obj' ]), "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 22, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); $o2->other2_obj({ id => 3, name => 'foo' }); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->other2_obj->name, 'foo', "single column foreign key 2 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 10 (bitfield value) - $db_type"); my $o3 = MyMySQLObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyMySQLObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); $o->other2_obj(MyMySQLOtherObject2->new(name => 'bar')); $o->save; $o = MyMySQLObject->new(id => $o->id)->load; is($o->other2_obj->name, 'bar', "single column foreign key 3 - $db_type"); ok($o->delete, "delete() - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, 'alias_column() nonesuch'); } # # Informix # SKIP: foreach my $db_type ('informix') { skip("Informix tests", 51) unless($HAVE_INFORMIX); Rose::DB->default_type($db_type); my $o = MyInformixObject->new(name => 'John', id => 1); ok(ref $o && $o->isa('MyInformixObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(7); $o->other2_obj(7); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); is($o->other2_obj->name, 'def', "single column foreign key 1 - $db_type"); my $old_fks = $o->fks; $o->other2_obj(undef); $o->fks(0); eval { $o->other2_obj }; ok($@, "fatal referential_integrity - $db_type"); ok(!defined $o->other2_obj_soft, "ok referential_integrity - $db_type"); $o->fks($old_fks); my $o2 = MyInformixObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyInformixObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 7, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); $o2->other2_obj({ id => 3, name => 'foo' }); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->other2_obj->name, 'foo', "single column foreign key 2 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyInformixObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyInformixObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); $o->other2_obj(MyInformixOtherObject2->new(name => 'bar')); $o->save; $o = MyInformixObject->new(id => $o->id)->load; is($o->other2_obj->name, 'bar', "single column foreign key 3 - $db_type"); ok($o->load, "load() 4 - $db_type"); my $o5 = MyInformixObject->new(id => $o->id); ok($o5->load, "load() 5 - $db_type"); $o5->nums([ 4, 5, 6 ]); ok($o5->save, "save() 4 - $db_type"); ok($o->load, "load() 6 - $db_type"); is($o5->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o5->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o5->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o5->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); my $oo1 = MyInformixOtherObject->new(k1 => 1, k2 => 2, k3 => 3, name => 'one'); ok($oo1->save, 'other object save() 1'); my $oo2 = MyInformixOtherObject->new(k1 => 11, k2 => 12, k3 => 13, name => 'two'); ok($oo2->save, 'other object save() 2'); is($o->other_obj, undef, 'other_obj() 1'); $o->fkone(1); $o->fk2(2); $o->fk3(3); my $obj = $o->other_obj or warn "# ", $o->error, "\n"; is(ref $obj, 'MyInformixOtherObject', 'other_obj() 2'); is($obj->name, 'one', 'other_obj() 3'); $o->other_obj(undef); $o->fkone(11); $o->fk2(12); $o->fk3(13); $obj = $o->other_obj or warn "# ", $o->error, "\n"; is(ref $obj, 'MyInformixOtherObject', 'other_obj() 4'); is($obj->name, 'two', 'other_obj() 5'); ok($o->delete, "delete() - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, 'alias_column() nonesuch'); } # # SQLite # SKIP: foreach my $db_type ('sqlite') { skip("SQLite tests", 53) unless($HAVE_SQLITE); Rose::DB->default_type($db_type); is(MySQLiteObject->meta->foreign_key('other_obj')->key_column('fk1'), 'k1', "key_column 1 - $db_type"); is(MySQLiteObject->meta->foreign_key('other_obj')->key_column('fk2'), 'k2', "key_column 2 - $db_type"); my $o = MySQLiteObject->new(name => 'John', id => 1); ok(ref $o && $o->isa('MySQLiteObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(7); $o->other2_obj(7); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); is($o->other2_obj->name, 'def', "single column foreign key 1 - $db_type"); my $old_fks = $o->fks; $o->other2_obj(undef); $o->fks(0); eval { $o->other2_obj }; ok($@, "fatal referential_integrity - $db_type"); ok(!defined $o->other2_obj_soft, "ok referential_integrity - $db_type"); $o->fks($old_fks); my $o2 = MySQLiteObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MySQLiteObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 7, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); $o2->other2_obj({ id => 3, name => 'foo' }); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->other2_obj->name, 'foo', "single column foreign key 2 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MySQLiteObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MySQLiteObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); $o->other2_obj(MySQLiteOtherObject2->new(name => 'bar')); $o->save; $o = MySQLiteObject->new(id => $o->id)->load; is($o->other2_obj->name, 'bar', "single column foreign key 3 - $db_type"); ok($o->load, "load() 4 - $db_type"); my $o5 = MySQLiteObject->new(id => $o->id); ok($o5->load, "load() 5 - $db_type"); $o5->nums([ 4, 5, 6 ]); ok($o5->save, "save() 4 - $db_type"); ok($o->load, "load() 6 - $db_type"); is($o5->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o5->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o5->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o5->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); my $oo1 = MySQLiteOtherObject->new(k1 => 1, k2 => 2, k3 => 3, name => 'one'); ok($oo1->save, 'other object save() 1'); my $oo2 = MySQLiteOtherObject->new(k1 => 11, k2 => 12, k3 => 13, name => 'two'); ok($oo2->save, 'other object save() 2'); is($o->other_obj, undef, 'other_obj() 1'); $o->fkone(1); $o->fk2(2); $o->fk3(3); my $obj = $o->other_obj or warn "# ", $o->error, "\n"; is(ref $obj, 'MySQLiteOtherObject', 'other_obj() 2'); is($obj->name, 'one', 'other_obj() 3'); $o->other_obj(undef); $o->fkone(11); $o->fk2(12); $o->fk3(13); $obj = $o->other_obj or warn "# ", $o->error, "\n"; is(ref $obj, 'MySQLiteOtherObject', 'other_obj() 4'); is($obj->name, 'two', 'other_obj() 5'); ok($o->delete, "delete() - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, 'alias_column() nonesuch'); } BEGIN { # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_PG = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->do('DROP TABLE rose_db_object_other2'); $dbh->do('DROP TABLE rose_db_object_chkpass_test'); } our $PG_HAS_CHKPASS = pg_has_chkpass(); $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32), UNIQUE(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other2 ( id SERIAL PRIMARY KEY, name VARCHAR(32) DEFAULT 'def' ) EOF # Create test foreign subclasses package MyPgOtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } MyPgOtherObject->meta->table('rose_db_object_other'); MyPgOtherObject->meta->columns ( name => { type => 'varchar'}, k1 => { type => 'int' }, k2 => { type => 'int' }, k3 => { type => 'int' }, ); MyPgOtherObject->meta->primary_key_columns([ qw(k1 k2 k3) ]); MyPgOtherObject->meta->initialize; package MyPgOtherObject2; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } MyPgOtherObject2->meta->table('rose_db_object_other2'); MyPgOtherObject2->meta->columns ( id => { primary_key => 1 }, name => { type => 'varchar', default => 'def' }, ); MyPgOtherObject2->meta->initialize; $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id SERIAL PRIMARY KEY, @{[ $PG_HAS_CHKPASS ? 'password CHKPASS,' : '' ]} name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits BIT(5) NOT NULL DEFAULT B'00101', start DATE, save INT, nums INT[], fk1 INT, fk2 INT, fk3 INT, fks INT REFERENCES rose_db_object_other2 (id), last_modified TIMESTAMP, date_created TIMESTAMP, FOREIGN KEY (fk1, fk2, fk3) REFERENCES rose_db_object_other (k1, k2, k3) ) EOF $dbh->disconnect; # Create test subclass package MyPgObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } MyPgObject->meta->table('rose_db_object_test'); MyPgObject->meta->columns ( 'name', id => { primary_key => 1, type => 'serial' }, ($PG_HAS_CHKPASS ? (password => { type => 'chkpass' }) : ()), flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, nums => { type => 'array' }, bits => { type => 'bitfield', bits => 5, default => 101 }, fk1 => { type => 'int' }, fk2 => { type => 'int' }, fk3 => { type => 'int' }, fks => { type => 'int' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); MyPgObject->meta->foreign_keys ( other_obj => { class => 'MyPgOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, with_column_triggers => 1, }, other2_obj => { class => 'MyPgOtherObject2', key_columns => { fks => 'id', }, with_column_triggers => 1, }, other2_obj_soft => { class => 'MyPgOtherObject2', key_columns => { fks => 'id', }, referential_integrity => 0, with_column_triggers => 1, }, ); MyPgObject->meta->alias_column(fk1 => 'fkone'); eval { MyPgObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MyPgObject->meta->alias_column(save => 'save_col'); MyPgObject->meta->initialize(preserve_existing => 1); } # # MySQL # my $db_version; eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh() or die Rose::DB->error; $db_version = $db->database_version; }; if(!$@ && $dbh) { our $HAVE_MYSQL = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->do('DROP TABLE rose_db_object_other2'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32), KEY(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other2 ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(32) DEFAULT 'def' ) EOF # Create test foreign subclasses package MyMySQLOtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } MyMySQLOtherObject->meta->table('rose_db_object_other'); MyMySQLOtherObject->meta->columns ( name => { type => 'varchar'}, k1 => { type => 'int' }, k2 => { type => 'int' }, k3 => { type => 'int' }, ); MyMySQLOtherObject->meta->primary_key_columns([ qw(k1 k2 k3) ]); MyMySQLOtherObject->meta->initialize; package MyMySQLOtherObject2; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } MyMySQLOtherObject2->meta->table('rose_db_object_other2'); MyMySQLOtherObject2->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', default => 'def' }, ); MyMySQLOtherObject2->meta->initialize; # MySQL 5.0.3 or later has a completely stupid "native" BIT type my $bit_col = ($db_version >= 5_000_003) ? q(bits BIT(5) NOT NULL DEFAULT B'00101') : q(bits BIT(5) NOT NULL DEFAULT '00101'); $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, name VARCHAR(32) NOT NULL, flag TINYINT(1) NOT NULL, flag2 TINYINT(1), status VARCHAR(32) DEFAULT 'active', $bit_col, start DATE, save INT, fk1 INT, fk2 INT, fk3 INT, fks INT REFERENCES rose_db_object_other2 (id), last_modified TIMESTAMP, date_created DATETIME ) EOF $dbh->disconnect; # Create test subclass package MyMySQLObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } MyMySQLObject->meta->allow_inline_column_values(1); MyMySQLObject->meta->table('rose_db_object_test'); MyMySQLObject->meta->columns ( 'name', id => { primary_key => 1 }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, bits => { type => 'bitfield', bits => 5, default => 101 }, fk1 => { type => 'int' }, fk2 => { type => 'int' }, fk3 => { type => 'int' }, fks => { type => 'int' }, last_modified => { type => 'timestamp' }, date_created => { type => 'datetime' }, ); MyMySQLObject->meta->foreign_keys ( other_obj => { class => 'MyMySQLOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', } }, other2_obj => { class => 'MyMySQLOtherObject2', key_columns => { fks => 'id', }, }, other2_obj_soft => { class => 'MyMySQLOtherObject2', key_columns => { fks => 'id', }, soft => 1, }, ); eval { MyMySQLObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MyMySQLObject->meta->alias_column(save => 'save_col'); MyMySQLObject->meta->initialize(preserve_existing => 1); } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_INFORMIX = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->do('DROP TABLE rose_db_object_other2'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32), UNIQUE(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other2 ( id SERIAL PRIMARY KEY, name VARCHAR(32) DEFAULT 'def' ) EOF # Create test foreign subclasses package MyInformixOtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('informix') } MyInformixOtherObject->meta->table('rose_db_object_other'); MyInformixOtherObject->meta->columns ( name => { type => 'varchar'}, k1 => { type => 'int' }, k2 => { type => 'int' }, k3 => { type => 'int' }, ); MyInformixOtherObject->meta->primary_key_columns(qw(k1 k2 k3)); MyInformixOtherObject->meta->initialize; package MyInformixOtherObject2; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('informix') } MyInformixOtherObject2->meta->table('rose_db_object_other2'); MyInformixOtherObject2->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', default => 'def' }, ); MyInformixOtherObject2->meta->initialize; $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits VARCHAR(5) DEFAULT '00101' NOT NULL, start DATE, save INT, nums VARCHAR(255), fk1 INT, fk2 INT, fk3 INT, fks INT REFERENCES rose_db_object_other2 (id), last_modified DATETIME YEAR TO FRACTION(5), date_created DATETIME YEAR TO FRACTION(5), FOREIGN KEY (fk1, fk2, fk3) REFERENCES rose_db_object_other (k1, k2, k3) ) EOF $dbh->disconnect; # Create test subclass package MyInformixObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('informix') } MyInformixObject->meta->table('rose_db_object_test'); MyInformixObject->meta->columns ( 'name', id => { primary_key => 1 }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, nums => { type => 'array' }, bits => { type => 'bitfield', bits => 5, default => 101 }, fk1 => { type => 'int' }, fk2 => { type => 'int' }, fk3 => { type => 'int' }, fks => { type => 'int' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); MyInformixObject->meta->foreign_keys ( other_obj => { class => 'MyInformixOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', } }, other2_obj => { class => 'MyInformixOtherObject2', key_columns => { fks => 'id', }, }, other2_obj_soft => { class => 'MyInformixOtherObject2', key_columns => { fks => 'id', }, referential_integrity => 0, }, ); MyInformixObject->meta->alias_column(fk1 => 'fkone'); eval { MyInformixObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MyInformixObject->meta->alias_column(save => 'save_col'); MyInformixObject->meta->initialize(preserve_existing => 1); } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_SQLITE = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->do('DROP TABLE rose_db_object_other2'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32), UNIQUE(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other2 ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(32) DEFAULT 'def' ) EOF # Create test foreign subclasses package MySQLiteOtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MySQLiteOtherObject->meta->table('rose_db_object_other'); MySQLiteOtherObject->meta->columns ( name => { type => 'varchar'}, k1 => { type => 'int' }, k2 => { type => 'int' }, k3 => { type => 'int' }, ); MySQLiteOtherObject->meta->primary_key_columns(qw(k1 k2 k3)); MySQLiteOtherObject->meta->initialize; package MySQLiteOtherObject2; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MySQLiteOtherObject2->meta->table('rose_db_object_other2'); MySQLiteOtherObject2->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', default => 'def' }, ); MySQLiteOtherObject2->meta->initialize; $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits VARCHAR(5) DEFAULT '00101' NOT NULL, start DATE, save INT, nums VARCHAR(255), fk1 INT, fk2 INT, fk3 INT, fks INT REFERENCES rose_db_object_other2 (id), last_modified TIMESTAMP, date_created TIMESTAMP, FOREIGN KEY (fk1, fk2, fk3) REFERENCES rose_db_object_other (k1, k2, k3) ) EOF $dbh->disconnect; # Create test subclass package MySQLiteObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MySQLiteObject->meta->table('rose_db_object_test'); MySQLiteObject->meta->columns ( 'name', id => { primary_key => 1 }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, nums => { type => 'array' }, bits => { type => 'bitfield', bits => 5, default => 101 }, fk1 => { type => 'int' }, fk2 => { type => 'int' }, fk3 => { type => 'int' }, fks => { type => 'int' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); MySQLiteObject->meta->foreign_keys ( other_obj => { class => 'MySQLiteOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', } }, other2_obj => { class => 'MySQLiteOtherObject2', key_columns => { fks => 'id', }, }, other2_obj_soft => { class => 'MySQLiteOtherObject2', key_columns => { fks => 'id', }, soft => 1, }, ); MySQLiteObject->meta->alias_column(fk1 => 'fkone'); eval { MySQLiteObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MySQLiteObject->meta->alias_column(save => 'save_col'); MySQLiteObject->meta->initialize(preserve_existing => 1); } } END { # Delete test table if($HAVE_PG) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->do('DROP TABLE rose_db_object_other2'); $dbh->disconnect; } if($HAVE_MYSQL) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->do('DROP TABLE rose_db_object_other2'); $dbh->disconnect; } if($HAVE_INFORMIX) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->do('DROP TABLE rose_db_object_other2'); $dbh->disconnect; } if($HAVE_SQLITE) { # SQLite my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->do('DROP TABLE rose_db_object_other2'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-helpers.t000755 000765 000120 00000050636 11431531362 020141 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; #use Test::LongString; use Test::More tests => (91 * 4) + 3; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Manager'); use_ok('Rose::DB::Object::Helpers'); } our(%Have, $Have_YAML, $Have_JSON); # # Tests # use Rose::DB::Object::Util qw(:state get_column_value_modified); my $i = 0; foreach my $db_type (qw(mysql pg informix sqlite)) { SKIP: { skip("$db_type tests", 91) unless($Have{$db_type}); } next unless($Have{$db_type}); MyMixIn->clear_export_tags; MyMixIn->export_tag('all' => [ 'a', 'b' ]); my $class = 'My' . ucfirst($db_type) . 'Object'; my $other_class = 'My' . ucfirst($db_type) . 'OtherObject'; my $o = $class->new(id => 1, name => 'John', age => 30); my @tags = MyMixIn->export_tags; is_deeply(\@tags, [ 'all' ], "export_tags() 1 - $db_type"); my $tags = MyMixIn->export_tags; is_deeply($tags, [ 'all' ], "export_tags() 1 - $db_type"); eval { MyMixIn->export_tag('foo') }; ok($@, "export_tag() 1 - $db_type"); MyMixIn->export_tag('foo' => [ 'bar', 'baz' ]); my @methods = sort(MyMixIn->export_tag('foo')); is_deeply(\@methods, [ 'bar', 'baz' ], "export_tag() 1 - $db_type"); my $methods = MyMixIn->export_tag('foo'); $methods = [ sort @$methods ]; is_deeply($methods, [ 'bar', 'baz' ], "export_tag() 2 - $db_type"); eval { MyMixIn->export_tag('foo', 'bar') }; ok($@, "export_tag() 3 - $db_type"); eval { MyMixIn->export_tag('foo', [ 'bar' ], 'baz') }; ok($@, "export_tag() 4 - $db_type"); MyMixIn->clear_export_tags; @tags = MyMixIn->export_tags; is_deeply(\@tags, [ ], "clear_export_tags() 1 - $db_type"); MyMixIn->add_export_tags('foo' => [], 'all' => []); MyMixIn->delete_export_tags('foo', 'all'); @tags = MyMixIn->export_tags; is_deeply(\@tags, [ ], "delete_export_tags() 1 - $db_type"); MyMixIn->export_tag('xx', [ 'a' ]); @tags = MyMixIn->export_tags; is_deeply(\@tags, [ 'xx' ], "export_tag() 5 - $db_type"); MyMixIn->delete_export_tag('xx'); @tags = MyMixIn->export_tags; is_deeply(\@tags, [ ], "delete_export_tag() 1 - $db_type"); ok(!$o->load_speculative, "load_speculative() 1 - $db_type"); ok($o->load_or_insert(), "load_or_insert() 1 - $db_type"); $o = $class->new(id => 1); ok($o->load_speculative, "load_speculative() 2 - $db_type"); $o = $class->new(id => 2, name => 'Alex'); ok($o->find_or_create(), "find_or_create() 1 - $db_type"); $o = $class->new(id => 2); ok($o->find_or_create(), "find_or_create() 2 - $db_type"); $o = $class->new(id => 2); ok($o->load_speculative, "load_speculative() 3 - $db_type"); my $other = $other_class->new(name => 'foo'); my $o3 = $class->new(id => 5, name => 'load_or_save', rose_db_object_test_other => $other)->load_or_save; $o3 = $class->new(id => $o3->id)->load; is($o3->name, 'load_or_save', "load_or_save() 1 - $db_type"); $other = $other_class->new(id => $other->id)->load; is($other->name, 'foo', "load_or_save() 2 - $db_type"); my $o2 = $o->clone; is($o2->id, $o->id, "clone() 1 - $db_type"); is($o2->name, $o->name, "clone() 2 - $db_type"); is($o2->age, $o->age, "clone() 3 - $db_type"); ok(!defined $o2->{'db'}, "clone() 4 - $db_type"); $o2 = $o->clone_and_reset; ok(!defined $o2->id, "clone_and_reset() 1 - $db_type"); # Crazy MySQL prvides an empty string as a default value # (or no default for 5.0.51, apparently) if($db_type eq 'mysql') { no warnings 'uninitialized'; ok(!length $o2->name, "clone_and_reset() 2 - $db_type"); } else { ok(!defined $o2->name, "clone_and_reset() 2 - $db_type"); } is($o2->age, $o->age, "clone_and_reset() 3 - $db_type"); is($o2->db, $o->db, "clone_and_reset() 4 - $db_type"); my $clone = $class->new(id => 2)->load->clone; $clone->laz('Z0'); foreach my $i (1, 2) { $clone->update; # reset to initial state $o->meta->allow_inline_column_values($i == 2); #local $Rose::DB::Object::Debug = 1; # Insert or update $o = $class->new(id => 2, name => 'Alex', age => 2); $o->insert_or_update; $o2 = $class->new(id => 2)->load; is($o2->name, 'Alex', "insert_or_update() 1.$i - $db_type"); is($o2->laz, 'Z0', "insert_or_update() 2.$i - $db_type"); # Insert or update - update regular and lazy columns $o->name('Alex2'); $o->laz('Z1'); $o->insert_or_update; $o2 = $class->new(id => 2)->load; is($o2->name, 'Alex2', "insert_or_update() 3.$i - $db_type"); is($o2->laz, 'Z1', "insert_or_update() 4.$i - $db_type"); # Insert or update on duplicate key $o = $class->new(id => 2, name => 'Alex3', age => 3); $o->insert_or_update_on_duplicate_key; $o2 = $class->new(id => 2)->load; is($o2->name, 'Alex3', "insert_or_update_on_duplicate_key() 1.$i - $db_type"); is($o2->age, 3, "insert_or_update_on_duplicate_key() 2.$i - $db_type"); is($o2->laz, 'Z1', "insert_or_update_on_duplicate_key() 3.$i - $db_type"); is($o2->id, 2, "insert_or_update_on_duplicate_key() 4.$i - $db_type"); # Insert or update on duplicate key - with unique key only $o = $class->new(name => 'Alex3', age => 5); $o->insert_or_update_on_duplicate_key; $o = $class->new(name => 'Alex3')->load; is($o->name, 'Alex3', "insert_or_update_on_duplicate_key() 5.$i - $db_type"); is($o->age, 5, "insert_or_update_on_duplicate_key() 6.$i - $db_type"); is($o->laz, 'Z1', "insert_or_update_on_duplicate_key() 7.$i - $db_type"); is($o->id, 2, "insert_or_update_on_duplicate_key() 8.$i - $db_type"); $o = $class->new(name => 'Alex3', laz => 'Z2', age => 5); $o->insert_or_update_on_duplicate_key; $o = $class->new(name => 'Alex3')->load; is($o->name, 'Alex3', "insert_or_update_on_duplicate_key() 9.$i - $db_type"); is($o->age, 5, "insert_or_update_on_duplicate_key() 10.$i - $db_type"); is($o->laz, 'Z2', "insert_or_update_on_duplicate_key() 11.$i - $db_type"); is($o->id, 2, "insert_or_update_on_duplicate_key() 12.$i - $db_type"); $o = $class->new(name => 'Alex3')->load; $o->age(6); #local $Rose::DB::Object::Debug = 1; $o->insert_or_update_on_duplicate_key(changes_only => 1); $o = $class->new(name => 'Alex3')->load; is($o->name, 'Alex3', "insert_or_update_on_duplicate_key() 13.$i - $db_type"); is($o->age, 6, "insert_or_update_on_duplicate_key() 14.$i - $db_type"); is($o->laz, 'Z2', "insert_or_update_on_duplicate_key() 15.$i - $db_type"); is($o->id, 2, "insert_or_update_on_duplicate_key() 16.$i - $db_type"); } $o->meta->allow_inline_column_values(0); is_deeply(scalar $o->column_value_pairs(), { age => 6, id => 2, laz => 'Z2', name => 'Alex3' }, "column_value_pairs() - $db_type"); is_deeply(scalar $o->column_accessor_value_pairs(), { age => 6, id => 2, get_laz => 'Z2', name => 'Alex3' }, "column_accessor_value_pairs() - $db_type"); is_deeply(scalar $o->column_mutator_value_pairs(), { age => 6, id => 2, set_laz => 'Z2', name => 'Alex3' }, "column_mutator_value_pairs() - $db_type"); my $c = $class->new(age => 456); $c->init_with_column_value_pairs({ age => 6, laz => 'Z3', name => 'Alex4' }); is($c->get_laz, 'Z3', "init_with_column_value_pairs() 1 - $db_type"); is($c->name, 'Alex4', "init_with_column_value_pairs() 2 - $db_type"); $c = $class->new(age => 456); $c->init_with_column_value_pairs(age => 6, laz => 'Z4', name => 'Alex5'); is($c->get_laz, 'Z4', "init_with_column_value_pairs() 3 - $db_type"); is($c->name, 'Alex5', "init_with_column_value_pairs() 4 - $db_type"); if($Have_YAML) { local $YAML::Syck::SortKeys = 1; $YAML::Syck::SortKeys = 1; # quiet stupid perl 5.6.x warning my $yaml = $o->column_values_as_yaml; $yaml =~ s/'//g; # number/string issues are annoying... is($yaml, "--- \nage: 6\nid: 2\nlaz: Z2\nname: Alex3\n", "column_values_as_yaml() - $db_type"); my $c = $class->new(age => 456); $c->init_with_yaml($yaml); is($c->column_values_as_yaml, "--- \nage: 6\nid: 2\nlaz: Z2\nname: Alex3\n", "init_with_yaml() - $db_type") } else { ok(1, "skip column_values_as_yaml() - $db_type"); ok(1, "skip init_with_yaml() - $db_type"); } if($Have_JSON) { # I don't know if I can rely on this key order... # {"laz":"Z2","name":"Alex3","id":2,"age":6} my $json = $o->column_values_as_json; ok($json =~ /^\{/ && $json =~ /"laz": "Z2"/ && $json =~ /"name": "Alex3"/ && $json =~ /"id": (?:2|"2")/ && $json =~ /"age": (?:6|"6")/ && $json =~ /\}\z/, "column_values_as_json() - $db_type"); my $c = $class->new(age => 456); $c->init_with_json($json); ok($json =~ /^\{/ && $json =~ /"laz": "Z2"/ && $json =~ /"name": "Alex3"/ && $json =~ /"id": (?:2|"2")/ && $json =~ /"age": (?:6|"6")/ && $json =~ /\}\z/, "init_with_json() - $db_type"); } else { ok(1, "skip column_values_as_json() - $db_type"); ok(1, "skip init_with_json() - $db_type"); } $c = $class->new(age => 456); set_state_loading($c); ok(is_loading($c), "state utils - $db_type"); unset_state_loading($c); # has_loaded_related() tested in db-object-relationship.t # forget_related() tested in db-object-relationship.t eval { require Storable }; unless($@) { $o = $class->new(id => 1)->load_or_save; # Confirm stripping of "on-save" code references $o->rose_db_object_test_other({ name => 'test' }); eval { $o->strip }; like($@, qr/Refusing to strip "on-save" actions from \w+ object without strip_on_save_ok parameter/, "strip 1 - $db_type"); my $frozen = Storable::freeze($o->strip(strip_on_save_ok => 1)); my $thawed = Storable::thaw($frozen); is_deeply($thawed, $o, "strip 2 - $db_type"); } else { SKIP: { skip("tests that require Storable - $db_type", 2) } } $o = $class->new(id => 1, name => 'John', age => 30)->load_or_save; is(scalar $o->dirty_columns, 0, "dirty_columns 1 - $db_type"); $o->dirty_columns(qw(name age)); is(scalar $o->dirty_columns, 2, "dirty_columns 2 - $db_type"); is(join(',', sort $o->dirty_columns), 'age,name', "dirty_columns 3 - $db_type"); ok(get_column_value_modified($o, 'age'), "dirty_columns 4 - $db_type"); ok(get_column_value_modified($o, 'name'), "dirty_columns 5 - $db_type"); # insert_or_update with no key Rose::DB::Object::Manager->delete_objects(all => 1, object_class => $other_class); Rose::DB::Object::Manager->delete_objects(all => 1, object_class => $class); my $unknown = $class->new(age => 99); eval { $unknown->insert_or_update }; ok(!$@ && $unknown->id =~ /^\d+$/, "insert_or_update() with no key - $db_type"); # Must remove all data to prevent a UK conflict where name is NULL Rose::DB::Object::Manager->delete_objects(all => 1, object_class => $other_class); Rose::DB::Object::Manager->delete_objects(all => 1, object_class => $class); # load_or_insert with no key $unknown = $class->new(age => 100); eval { $unknown->load_or_insert }; ok(!$@ && $unknown->id =~ /^\d+$/, "load_or_insert() with no key - $db_type"); # Must remove all data to prevent a UK conflict where name is NULL Rose::DB::Object::Manager->delete_objects(all => 1, object_class => $other_class); Rose::DB::Object::Manager->delete_objects(all => 1, object_class => $class); # load_or_save with no key $unknown = $class->new(age => 101); eval { $unknown->load_or_save }; ok(!$@ && $unknown->id =~ /^\d+$/, "load_or_save() with no key - $db_type"); } BEGIN { our(%Have, $Have_YAML, $Have_JSON, $All); # All or nothing eval { require YAML::Syck; require JSON; }; $All = $@ ? ':all_noprereq' : ':all'; unless($@) { $Have_YAML = $Have_JSON = 1; } if($Have_JSON) { no warnings 'uninitialized'; unless($JSON::VERSION >= 2.12) { $Have_YAML = $Have_JSON = 0; } eval { require JSON::XS }; if(defined $JSON::XS::VERSION && $JSON::XS::VERSION < 2.2222) { $Have_YAML = $Have_JSON = 0; } } $All = ':all_noprereq' unless($Have_YAML && $Have_YAML); } BEGIN { our(%Have, $Have_YAML, $Have_JSON, $All); # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test_other'); $dbh->do('DROP TABLE rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255), age INT, laz VARCHAR(255), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_other ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255), rose_db_object_test_id INT REFERENCES rose_db_object_test (id) ) EOF $dbh->disconnect; package MyPgObject; our @ISA = qw(Rose::DB::Object); use Rose::DB::Object::Helpers ($All); eval { Rose::DB::Object::Helpers->import($All) }; Test::More::ok($@, 'import conflict - pg'); eval { Rose::DB::Object::Helpers->import('-force', $All) }; Test::More::ok(!$@, 'import override - pg'); Rose::DB::Object::Helpers->import({ load_or_insert => 'find_or_create' }); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->table('rose_db_object_test'); __PACKAGE__->meta->auto_initialize; __PACKAGE__->meta->column('laz')->lazy(1); __PACKAGE__->meta->column('laz')->add_auto_method_types(qw(get set)); __PACKAGE__->meta->initialize(replace_existing => 1); package MyPgOtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } __PACKAGE__->meta->table('rose_db_object_test_other'); __PACKAGE__->meta->auto_initialize; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; die "MySQL version too old" unless($db->database_version >= 4_000_000); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test_other'); $dbh->do('DROP TABLE rose_db_object_test'); } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255), age INT, laz VARCHAR(255), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_other ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255), rose_db_object_test_id INT REFERENCES rose_db_object_test (id) ) EOF $dbh->disconnect; package MyMysqlObject; our @ISA = qw(Rose::DB::Object); use Rose::DB::Object::Helpers ($All); eval { Rose::DB::Object::Helpers->import(qw(load_or_insert load_speculative insert_or_update)) }; Test::More::ok($@, 'import conflict - mysql'); eval { Rose::DB::Object::Helpers->import(qw(--force load_or_insert load_speculative)) }; Test::More::ok(!$@, 'import override - mysql'); Rose::DB::Object::Helpers->import({ load_or_insert => 'find_or_create' }); sub init_db { Rose::DB->new('mysql') } __PACKAGE__->meta->table('rose_db_object_test'); __PACKAGE__->meta->auto_initialize; __PACKAGE__->meta->column('laz')->lazy(1); __PACKAGE__->meta->column('laz')->add_auto_method_types(qw(get set)); __PACKAGE__->meta->add_relationship ( rose_db_object_test_other => { class => 'MyMysqlOtherObject', column_map => { id => 'rose_db_object_test_id' }, type => 'one to many', } ); __PACKAGE__->meta->initialize(replace_existing => 1); package MyMysqlOtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } __PACKAGE__->meta->table('rose_db_object_test_other'); __PACKAGE__->meta->auto_initialize; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test_other'); $dbh->do('DROP TABLE rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255), age INT, laz VARCHAR(255), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_other ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255), rose_db_object_test_id INT REFERENCES rose_db_object_test (id) ) EOF $dbh->disconnect; package MyInformixObject; our @ISA = qw(Rose::DB::Object); use Rose::DB::Object::Helpers ($All); eval { Rose::DB::Object::Helpers->import($All) }; Test::More::ok($@, 'import conflict - informix'); eval { Rose::DB::Object::Helpers->import('-force', $All) }; Test::More::ok(!$@, 'import override - informix'); Rose::DB::Object::Helpers->import({ load_or_insert => 'find_or_create' }); sub init_db { Rose::DB->new('informix') } __PACKAGE__->meta->table('rose_db_object_test'); __PACKAGE__->meta->auto_initialize; __PACKAGE__->meta->column('laz')->lazy(1); __PACKAGE__->meta->column('laz')->add_auto_method_types(qw(get set)); __PACKAGE__->meta->initialize(replace_existing => 1); package MyInformixOtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('informix') } __PACKAGE__->meta->table('rose_db_object_test_other'); __PACKAGE__->meta->auto_initialize; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test_other'); $dbh->do('DROP TABLE rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255), age INT, laz VARCHAR(255), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_other ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255), rose_db_object_test_id INT REFERENCES rose_db_object_test (id) ) EOF $dbh->disconnect; package MySqliteObject; our @ISA = qw(Rose::DB::Object); use Rose::DB::Object::Helpers ($All); eval { Rose::DB::Object::Helpers->import($All) }; Test::More::ok($@, 'import conflict - sqlite'); eval { Rose::DB::Object::Helpers->import('--force', $All) }; Test::More::ok(!$@, 'import override - sqlite'); Rose::DB::Object::Helpers->import({ load_or_insert => 'find_or_create' }); sub init_db { Rose::DB->new('sqlite') } __PACKAGE__->meta->table('rose_db_object_test'); __PACKAGE__->meta->auto_initialize; __PACKAGE__->meta->column('laz')->lazy(1); __PACKAGE__->meta->column('laz')->add_auto_method_types(qw(get set)); __PACKAGE__->meta->initialize(replace_existing => 1); package MySqliteOtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } __PACKAGE__->meta->table('rose_db_object_test_other'); __PACKAGE__->meta->auto_initialize; } package MyMixIn; use Rose::DB::Object::MixIn; our @ISA = qw(Rose::DB::Object::MixIn); } END { # Delete test tables if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test_other'); $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test_other'); $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } if($Have{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test_other'); $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } if($Have{'sqlite'}) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test_other'); $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-loader-2.t000755 000765 000120 00000037651 11653604702 020113 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 1 + (5 * 18); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Loader'); } our %Have; our @Tables = qw(vendors Products prices Colors product_color_map pk_test); our $Include_Tables = join('|', @Tables); SETUP: { package My::DB; our @ISA = qw(Rose::DB); package My::DB::Object; our @ISA = qw(Rose::DB::Object); sub foo_bar { 123 } package MyWeirdClass; our @ISA = qw(Rose::Object); sub baz { 456 } } # # Tests # my $i = 1; foreach my $db_type (qw(mysql pg pg_with_schema informix sqlite)) { SKIP: { skip("$db_type tests", 18) unless($Have{$db_type}); } next unless($Have{$db_type}); $i++; My::DB->default_type($db_type); Rose::DB::Object::Metadata->unregister_all_classes; my $class_prefix = ucfirst($db_type eq 'pg_with_schema' ? 'pgws' : $db_type); #$Rose::DB::Object::Metadata::Debug = 1; my $loader = Rose::DB::Object::Loader->new( db => My::DB->new, base_classes => [ qw(My::DB::Object MyWeirdClass) ], class_prefix => $class_prefix); my @classes = $loader->make_classes(include_tables => $Include_Tables); #foreach my $class (@classes) #{ # next unless($class->isa('Rose::DB::Object')); # print $class->meta->perl_class_definition, "\n"; #} my $pk_class = $class_prefix . '::PkTest'; my @pk_cols = $pk_class->meta->primary_key_column_names; is_deeply(\@pk_cols, [ qw(num year) ], "multi pk - $db_type"); my $product_class = $class_prefix . '::Product'; ## ## Run tests ## my $p = $product_class->new(name => "Sled $i"); is($p->db->class, 'My::DB', "db 1 - $db_type"); ok($p->isa('My::DB::Object'), "base class 1 - $db_type"); ok($p->isa('MyWeirdClass'), "base class 2 - $db_type"); is($p->foo_bar, 123, "foo_bar 1 - $db_type"); is($p->baz, 456, "baz 1 - $db_type"); if($db_type eq 'pg_with_schema') { is($p->db->schema, lc 'Rose_db_object_private', "schema - $db_type"); } else { ok(1, "schema - $db_type"); } if($db_type =~ /^pg/) { is($p->meta->column('id')->perl_hash_definition, q(id => { type => 'serial', not_null => 1 }), "perl_hash_definition - $db_type"); } else { ok(1, "perl_hash_definition - $db_type"); } $p->vendor(name => "Acme $i"); $p->prices({ price => 1.25, region => 'US' }, { price => 4.25, region => 'UK' }); $p->colors({ name => 'red' }, { name => 'green' }); $p->save; $p = $product_class->new(id => $p->id)->load; is($p->vendor->name, "Acme $i", "vendor 1 - $db_type"); my @prices = sort { $a->price <=> $b->price } $p->prices; is(scalar @prices, 2, "prices 1 - $db_type"); is($prices[0]->price, 1.25, "prices 2 - $db_type"); is($prices[1]->price, 4.25, "prices 3 - $db_type"); my @colors = sort { $a->name cmp $b->name } $p->colors; is(scalar @colors, 2, "colors 1 - $db_type"); is($colors[0]->name, 'green', "colors 2 - $db_type"); is($colors[1]->name, 'red', "colors 3 - $db_type"); my $mgr_class = $class_prefix . '::Product::Manager'; my $prods = $mgr_class->get_products(query => [ id => $p->id ]); is(ref $prods, 'ARRAY', "get_products 1 - $db_type"); is(@$prods, 1, "get_products 2 - $db_type"); is($prods->[0]->id, $p->id, "get_products 3 - $db_type"); #$DB::single = 1; #$Rose::DB::Object::Debug = 1; } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE pk_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.product_color_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); } $dbh->do(<<"EOF"); CREATE TABLE pk_test ( num INT NOT NULL, year VARCHAR(255) NOT NULL, name VARCHAR(255), PRIMARY KEY(num, year) ) EOF $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP NOT NULL DEFAULT NOW(), release_date TIMESTAMP, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.pk_test ( num INT NOT NULL, year VARCHAR(255) NOT NULL, name VARCHAR(255), PRIMARY KEY(num, year) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP NOT NULL DEFAULT NOW(), release_date TIMESTAMP, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; die "MySQL version too old" unless($db->database_version >= 4_000_000); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE pk_test CASCADE'); } # Foreign key stuff requires InnoDB support $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF # MySQL will silently ignore the "ENGINE=InnoDB" part and create # a MyISAM table instead. MySQL is evil! Now we have to manually # check to make sure an InnoDB table was really created. my $db_name = $db->database; my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?"); $sth->execute('vendors'); my $info = $sth->fetchrow_hashref; no warnings 'uninitialized'; unless(lc $info->{'Type'} eq 'innodb' || lc $info->{'Engine'} eq 'innodb') { die "Missing InnoDB support"; } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE pk_test ( num INT NOT NULL, year VARCHAR(255) NOT NULL, name VARCHAR(255), PRIMARY KEY(num, year) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT, status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP, release_date TIMESTAMP, UNIQUE(name), INDEX(vendor_id), FOREIGN KEY (vendor_id) REFERENCES vendors (id) ON DELETE NO ACTION ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INT AUTO_INCREMENT PRIMARY KEY, product_id INT NOT NULL, region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region), INDEX(product_id), FOREIGN KEY (product_id) REFERENCES products (id) ON UPDATE NO ACTION ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL, color_id INT NOT NULL, PRIMARY KEY(product_id, color_id), INDEX(color_id), INDEX(product_id), FOREIGN KEY (product_id) REFERENCES products (id) ON DELETE NO ACTION, FOREIGN KEY (color_id) REFERENCES colors (id) ON UPDATE NO ACTION ) ENGINE=InnoDB EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE pk_test CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE pk_test ( num INT NOT NULL, year VARCHAR(255) NOT NULL, name VARCHAR(255), PRIMARY KEY(num, year) ) EOF $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) DEFAULT 'inactive' NOT NULL CHECK(status IN ('inactive', 'active', 'defunct')), date_created DATETIME YEAR TO SECOND, release_date DATETIME YEAR TO SECOND, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); $dbh->do('DROP TABLE pk_test'); } $dbh->do(<<"EOF"); CREATE TABLE pk_test ( num INT NOT NULL, year VARCHAR(255) NOT NULL, name VARCHAR(255), PRIMARY KEY(num, year) ) EOF $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) DEFAULT 'inactive' NOT NULL CHECK(status IN ('inactive', 'active', 'defunct')), date_created DATETIME, release_date DATETIME, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INTEGER PRIMARY KEY AUTOINCREMENT, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } } END { # Delete test table if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE pk_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.product_color_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE pk_test CASCADE'); $dbh->disconnect; } if($Have{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE pk_test CASCADE'); $dbh->disconnect; } if($Have{'sqlite'}) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); $dbh->do('DROP TABLE pk_test'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-loader-3.t000755 000765 000120 00000034205 11653604702 020104 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 1 + (5 * 12); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Loader'); } our %Have; our @Tables = qw(vendors products prices colors products_colors); our $Include_Tables = join('|', @Tables); # # Tests # # We'll need to clear the registry since we're using DSN instead our $real_registry = Rose::DB->registry; our $empty_registry = Rose::DB::Registry->new; my $i = 1; foreach my $db_type (qw(mysql pg pg_with_schema informix sqlite)) { SKIP: { skip("$db_type tests", 12) unless($Have{$db_type}); } next unless($Have{$db_type}); $i++; Rose::DB->registry($real_registry); Rose::DB::Object::Metadata->unregister_all_classes; my $class_prefix = ucfirst($db_type eq 'pg_with_schema' ? 'pgws' : $db_type); #$Rose::DB::Object::Metadata::Debug = 1; my $db = Rose::DB->new($db_type); my $loader = Rose::DB::Object::Loader->new( db_dsn => $db->dsn, db_username => $db->username, db_password => $db->password, db_options => scalar $db->connect_options, class_prefix => $class_prefix); Rose::DB->registry($empty_registry); my @classes = $loader->make_classes(include_tables => $Include_Tables); my $product_class = $class_prefix . '::Product'; ## ## Run tests ## my $p = $product_class->new(name => "Sled $i"); $p->vendor(name => "Acme $i"); $p->prices({ price => 1.25, region => 'US' }, { price => 4.25, region => 'UK' }); $p->colors({ name => 'red' }, { name => 'green' }); $p->save; $p = $product_class->new(id => $p->id)->load; ok($p->db->class =~ /^${class_prefix}::DB::AutoBase\d+$/, "db 1 - $db_type"); OBJECT_CLASS: { no strict 'refs'; ok(${"${product_class}::ISA"}[0] =~ /^${class_prefix}::DB::Object::AutoBase\d+$/, "base class 1 - $db_type"); } is($p->vendor->name, "Acme $i", "vendor 1 - $db_type"); my @prices = sort { $a->price <=> $b->price } $p->prices; is(scalar @prices, 2, "prices 1 - $db_type"); is($prices[0]->price, 1.25, "prices 2 - $db_type"); is($prices[1]->price, 4.25, "prices 3 - $db_type"); my @colors = sort { $a->name cmp $b->name } $p->colors; is(scalar @colors, 2, "colors 1 - $db_type"); is($colors[0]->name, 'green', "colors 2 - $db_type"); is($colors[1]->name, 'red', "colors 3 - $db_type"); my $mgr_class = $class_prefix . '::Product::Manager'; my $prods = $mgr_class->get_products(query => [ id => $p->id ]); is(ref $prods, 'ARRAY', "get_products 1 - $db_type"); is(@$prods, 1, "get_products 2 - $db_type"); is($prods->[0]->id, $p->id, "get_products 3 - $db_type"); #$DB::single = 1; #$Rose::DB::Object::Debug = 1; } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE products_colors CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products_colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP NOT NULL DEFAULT NOW(), release_date TIMESTAMP, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products_colors ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP NOT NULL DEFAULT NOW(), release_date TIMESTAMP, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.products_colors ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; die "MySQL version too old" unless($db->database_version >= 4_000_000); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE products_colors CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } # Foreign key stuff requires InnoDB support $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF # MySQL will silently ignore the "ENGINE=InnoDB" part and create # a MyISAM table instead. MySQL is evil! Now we have to manually # check to make sure an InnoDB table was really created. my $db_name = $db->database; my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?"); $sth->execute('vendors'); my $info = $sth->fetchrow_hashref; no warnings 'uninitialized'; unless(lc $info->{'Type'} eq 'innodb' || lc $info->{'Engine'} eq 'innodb') { die "Missing InnoDB support"; } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE products ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT, status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP, release_date TIMESTAMP, UNIQUE(name), INDEX(vendor_id), FOREIGN KEY (vendor_id) REFERENCES vendors (id) ON DELETE NO ACTION ON UPDATE SET NULL ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INT AUTO_INCREMENT PRIMARY KEY, product_id INT NOT NULL, region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region), INDEX(product_id), FOREIGN KEY (product_id) REFERENCES products (id) ON UPDATE NO ACTION ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE products_colors ( product_id INT NOT NULL, color_id INT NOT NULL, PRIMARY KEY(product_id, color_id), INDEX(color_id), INDEX(product_id), FOREIGN KEY (product_id) REFERENCES products (id), FOREIGN KEY (color_id) REFERENCES colors (id) ) ENGINE=InnoDB EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE products_colors CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) DEFAULT 'inactive' NOT NULL CHECK(status IN ('inactive', 'active', 'defunct')), date_created DATETIME YEAR TO SECOND, release_date DATETIME YEAR TO SECOND, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products_colors ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE products_colors'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) DEFAULT 'inactive' NOT NULL CHECK(status IN ('inactive', 'active', 'defunct')), date_created DATETIME, release_date DATETIME, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INTEGER PRIMARY KEY AUTOINCREMENT, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products_colors ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } } END { # Delete test table Rose::DB->registry($real_registry); if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE products_colors CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products_colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE products_colors CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if($Have{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE products_colors CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if($Have{'sqlite'}) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE products_colors'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-loader-4.t000755 000765 000120 00000036144 12103007512 020074 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 1 + (5 * 16); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Loader'); } our %Have; our @Tables = qw(vendors products prices colors product_color_map); our $Include_Tables = join('|', @Tables); SETUP: { package My::DB; our @ISA = qw(Rose::DB); package My::DB::Object::Metadata; our @ISA = qw(Rose::DB::Object::Metadata); sub make_column_methods { my($self) = shift; $JCS::Called_For{$self->class}++; $self->SUPER::make_column_methods(@_); } package My::DB::Object; our @ISA = qw(Rose::DB::Object); sub meta_class { 'My::DB::Object::Metadata' } sub foo_bar { 123 } package MyWeirdClass; our @ISA = qw(Rose::Object); sub baz { 456 } } # # Tests # # We'll need to clear the registry since we're using DSN instead our $real_registry = Rose::DB->registry; our $empty_registry = Rose::DB::Registry->new; my $i = 1; foreach my $db_type (qw(mysql pg_with_schema pg informix sqlite)) { SKIP: { skip("$db_type tests", 16) unless($Have{$db_type}); } next unless($Have{$db_type}); $i++; Rose::DB->registry($real_registry); Rose::DB::Object::Metadata->unregister_all_classes; my $class_prefix = ucfirst($db_type eq 'pg_with_schema' ? 'pgws' : $db_type); #$Rose::DB::Object::Metadata::Debug = 1; my $db = My::DB->new($db_type); my $loader = Rose::DB::Object::Loader->new( db_dsn => $db->dsn, db_schema => $db->schema, db_username => $db->username, db_password => $db->password, base_classes => [ qw(My::DB::Object MyWeirdClass) ], class_prefix => $class_prefix); Rose::DB->registry($empty_registry); my @classes = $loader->make_classes(include_tables => $Include_Tables); my $product_class = $class_prefix . '::Product'; ok($JCS::Called_For{$product_class}, "custom metadata - $db_type"); ## ## Run tests ## no warnings qw(redefine once); *My::DB::Object::init_db = sub { $db }; my $p = $product_class->new(name => "Sled $i"); #ok($p->db->class =~ /^${class_prefix}::DB::AutoBase\d+$/, "db 1 - $db_type"); ok($p->isa('My::DB::Object'), "base class 1 - $db_type"); ok($p->isa('MyWeirdClass'), "base class 2 - $db_type"); is($p->foo_bar, 123, "foo_bar 1 - $db_type"); is($p->baz, 456, "baz 1 - $db_type"); if($db_type eq 'pg_with_schema') { is($p->db->schema, lc 'Rose_db_object_private', "schema - $db_type"); } else { ok(1, "schema - $db_type"); } $p->vendor(name => "Acme $i"); $p->prices({ price => 1.25, region => 'US' }, { price => 4.25, region => 'UK' }); $p->colors({ name => 'red' }, { name => 'green' }); $p->save; $p = $product_class->new(id => $p->id)->load; is($p->vendor->name, "Acme $i", "vendor 1 - $db_type"); my @prices = sort { $a->price <=> $b->price } $p->prices; is(scalar @prices, 2, "prices 1 - $db_type"); is($prices[0]->price, 1.25, "prices 2 - $db_type"); is($prices[1]->price, 4.25, "prices 3 - $db_type"); my @colors = sort { $a->name cmp $b->name } $p->colors; is(scalar @colors, 2, "colors 1 - $db_type"); is($colors[0]->name, 'green', "colors 2 - $db_type"); is($colors[1]->name, 'red', "colors 3 - $db_type"); my $mgr_class = $class_prefix . '::Product::Manager'; my $prods = $mgr_class->get_products(query => [ id => $p->id ]); is(ref $prods, 'ARRAY', "get_products 1 - $db_type"); is(@$prods, 1, "get_products 2 - $db_type"); is($prods->[0]->id, $p->id, "get_products 3 - $db_type"); #$DB::single = 1; #$Rose::DB::Object::Debug = 1; } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.product_color_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP NOT NULL DEFAULT NOW(), release_date TIMESTAMP, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT REFERENCES Rose_db_object_private.vendors (id), status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP NOT NULL DEFAULT NOW(), release_date TIMESTAMP, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES Rose_db_object_private.products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.product_color_map ( product_id INT NOT NULL REFERENCES Rose_db_object_private.products (id), color_id INT NOT NULL REFERENCES Rose_db_object_private.colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; die "MySQL version too old" unless($db->database_version >= 4_000_000); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } # Foreign key stuff requires InnoDB support $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF # MySQL will silently ignore the "ENGINE=InnoDB" part and create # a MyISAM table instead. MySQL is evil! Now we have to manually # check to make sure an InnoDB table was really created. my $db_name = $db->database; my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?"); $sth->execute('vendors'); my $info = $sth->fetchrow_hashref; no warnings 'uninitialized'; unless(lc $info->{'Type'} eq 'innodb' || lc $info->{'Engine'} eq 'innodb') { die "Missing InnoDB support"; } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE products ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT, status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP, release_date TIMESTAMP, UNIQUE(name), INDEX(vendor_id), FOREIGN KEY (vendor_id) REFERENCES vendors (id) ON DELETE NO ACTION ON UPDATE SET NULL ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INT AUTO_INCREMENT PRIMARY KEY, product_id INT NOT NULL, region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region), INDEX(product_id), FOREIGN KEY (product_id) REFERENCES products (id) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL, color_id INT NOT NULL, PRIMARY KEY(product_id, color_id), INDEX(color_id), INDEX(product_id), FOREIGN KEY (product_id) REFERENCES products (id), FOREIGN KEY (color_id) REFERENCES colors (id) ) ENGINE=InnoDB EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) DEFAULT 'inactive' NOT NULL CHECK(status IN ('inactive', 'active', 'defunct')), date_created DATETIME YEAR TO SECOND, release_date DATETIME YEAR TO SECOND, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) DEFAULT 'inactive' NOT NULL CHECK(status IN ('inactive', 'active', 'defunct')), date_created DATETIME, release_date DATETIME, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INTEGER PRIMARY KEY AUTOINCREMENT, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } } END { # Delete test table Rose::DB->registry($real_registry); if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.product_color_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if($Have{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if($Have{'sqlite'}) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-loader-5.t000755 000765 000120 00000045350 12103010161 020066 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use File::Spec; use File::Path; use FindBin qw($Bin); use Test::More tests => 1 + (5 * 19); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Loader'); } our %Have; our @Tables = qw(vendors products prices colors product_color_map); our $Module_Dir = File::Spec->catfile($Bin, 'loader_lib'); SETUP: { package My::DB; our @ISA = qw(Rose::DB); package My::DB::Object::Metadata; our @ISA = qw(Rose::DB::Object::Metadata); sub make_column_methods { my($self) = shift; $JCS::Called_For{$self->class}++; $self->SUPER::make_column_methods(@_); } package My::DB::Object; our @ISA = qw(Rose::DB::Object); sub meta_class { 'My::DB::Object::Metadata' } sub foo_bar { 123 } package MyWeirdClass; our @ISA = qw(Rose::Object); sub baz { 456 } File::Path::rmtree($Module_Dir) if(-d $Module_Dir); unless(-d $Module_Dir) { mkdir($Module_Dir); unless(-d $Module_Dir) { die "Could not mkdir($Module_Dir) - $!"; } } unshift(@INC, $Module_Dir); my $base_pm_dir = File::Spec->catfile($Module_Dir, 'My', 'DB', 'Object'); File::Path::mkpath($base_pm_dir); my $base_db_pm = File::Spec->catfile($Module_Dir, 'My', 'DB.pm'); open(my $fh, '>', $base_db_pm) or die "Could not create $base_db_pm - $!"; print $fh '', <<"EOF"; package My::DB; use base 'Rose::DB'; My::DB->use_private_registry; My::DB->register_db ( driver => 'sqlite', ); 1; EOF close($fh) or die "Could not write $base_db_pm - $!"; my $base_pm = File::Spec->catfile($Module_Dir, 'My', 'DB', 'Object.pm'); open($fh, '>', $base_pm) or die "Could not create $base_pm - $!"; print $fh '', <<"EOF"; package My::DB::Object; use base 'Rose::DB::Object'; use My::DB::Object::Metadata; sub meta_class { 'My::DB::Object::Metadata' } use My::DB; sub init_db { My::DB->new } sub foo_bar { 123 } 1; EOF close($fh) or die "Could not write $base_pm - $!"; my $base_meta_pm = File::Spec->catfile($Module_Dir, 'My', 'DB', 'Object', 'Metadata.pm'); open($fh, '>', $base_meta_pm) or die "Could not create $base_meta_pm - $!"; print $fh '', <<"EOF"; package My::DB::Object::Metadata; use base 'Rose::DB::Object::Metadata'; sub make_column_methods { my(\$self) = shift; \$JCS::Called_For{\$self->class}++; \$self->SUPER::make_column_methods(\@_); } 1; EOF close($fh) or die "Could not write $base_meta_pm - $!"; my $weird_pm = File::Spec->catfile($Module_Dir, 'MyWeirdClass.pm'); open($fh, '>', $weird_pm) or die "Could not create $weird_pm - $!"; print $fh "1;\n"; close($fh) or die "Could not write $weird_pm - $!"; } # # Tests # # We'll need to clear the registry since we're using DSN instead our $real_registry = Rose::DB->registry; our $empty_registry = Rose::DB::Registry->new; my $i = 1; foreach my $db_type (qw(mysql pg_with_schema pg informix sqlite)) { SKIP: { skip("$db_type tests", 19) unless($Have{$db_type}); } next unless($Have{$db_type}); $i++; Rose::DB->registry($real_registry); Rose::DB::Object::Metadata->unregister_all_classes; my $class_prefix = ucfirst($db_type eq 'pg_with_schema' ? 'pgws' : $db_type); #$Rose::DB::Object::Metadata::Debug = 1; my $db = My::DB->new($db_type); my $loader = Rose::DB::Object::Loader->new( db_dsn => $db->dsn, db_schema => $db->schema, db_username => $db->username, db_password => $db->password, base_classes => [ qw(My::DB::Object MyWeirdClass) ], class_prefix => $class_prefix); Rose::DB->registry($empty_registry); my @classes = $loader->make_modules(include_tables => \@Tables, module_dir => $Module_Dir); if($db_type eq 'pg') { is(Pg::Color->meta->column('id')->perl_hash_definition, q(id => { type => 'bigserial', not_null => 1 }), "bigserial perl_hash_definition 1 - $db_type"); is(Pg::Price->meta->column('id')->perl_hash_definition, q(id => { type => 'serial', not_null => 1 }), "bigserial perl_hash_definition 2 - $db_type"); } elsif($db_type eq 'pg_with_schema') { no warnings 'uninitialized'; my($v1, $v2, $v3) = split(/\./, $DBD::Pg::VERSION); my $extra = ($v1 >= 2 && $v2 >= 19) ? q(, sequence => 'rose_db_object_private.colors_id_seq') : ''; is(Pgws::Color->meta->column('id')->perl_hash_definition, qq(id => { type => 'bigserial', not_null => 1$extra }), "bigserial perl_hash_definition 1 - $db_type"); $extra = ($v1 >= 2 && $v2 >= 19) ? q(, sequence => 'rose_db_object_private.prices_id_seq') : ''; is(Pgws::Price->meta->column('id')->perl_hash_definition, qq(id => { type => 'serial', not_null => 1$extra }), "bigserial perl_hash_definition 2 - $db_type"); } else { SKIP: { skip('Pg serial tests', 2); } } foreach my $class (@classes) { my @path = split('::', $class); $path[-1] .= '.pm'; my $file = File::Spec->catfile($Module_Dir, @path); die "Missing $file" unless(-e $file, "make_modules() $class"); } my $product_class = $class_prefix . '::Product'; ok($JCS::Called_For{$product_class}, "custom metadata - $db_type"); ## ## Run tests ## no warnings qw(redefine once); *My::DB::Object::init_db = sub { $db }; my $p = $product_class->new(name => "Sled $i"); #ok($p->db->class =~ /^${class_prefix}::DB::AutoBase\d+$/, "db 1 - $db_type"); ok($p->isa('My::DB::Object'), "base class 1 - $db_type"); ok($p->isa('MyWeirdClass'), "base class 2 - $db_type"); is($p->foo_bar, 123, "foo_bar 1 - $db_type"); is($p->baz, 456, "baz 1 - $db_type"); if($db_type eq 'pg_with_schema') { is($p->db->schema, lc 'Rose_db_object_private', "schema - $db_type"); } else { ok(1, "schema - $db_type"); } $p->vendor(name => "Acme $i"); $p->prices({ price => 1.25, region => 'US' }, { price => 4.25, region => 'UK' }); $p->colors({ name => 'red' }, { name => 'green' }); $p->save; $ENV{'PERL5LIB'} = $ENV{'PERL5LIB'} ? "$Bin/../lib:$Bin/../../Rose-DB/lib:$ENV{'PERL5LIB'}" : "$Bin/../lib:$Bin/../../Rose-DB/lib"; my @cmd = ($^X, '-I', $Module_Dir, '-I', "$Bin/../../Rose-DB/lib", '-I', "$Bin/../lib", "-M$product_class", '-e', '0'); system(@cmd); is($? >> 8, 0, "external load - $db_type"); $p = $product_class->new(id => $p->id)->load; is($p->vendor->name, "Acme $i", "vendor 1 - $db_type"); my @prices = sort { $a->price <=> $b->price } $p->prices; is(scalar @prices, 2, "prices 1 - $db_type"); is($prices[0]->price, 1.25, "prices 2 - $db_type"); is($prices[1]->price, 4.25, "prices 3 - $db_type"); my @colors = sort { $a->name cmp $b->name } $p->colors; is(scalar @colors, 2, "colors 1 - $db_type"); is($colors[0]->name, 'green', "colors 2 - $db_type"); is($colors[1]->name, 'red', "colors 3 - $db_type"); my $mgr_class = $class_prefix . '::Product::Manager'; my $prods = $mgr_class->get_products(query => [ id => $p->id ]); is(ref $prods, 'ARRAY', "get_products 1 - $db_type"); is(@$prods, 1, "get_products 2 - $db_type"); is($prods->[0]->id, $p->id, "get_products 3 - $db_type"); #$DB::single = 1; #$Rose::DB::Object::Debug = 1; } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.product_color_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP NOT NULL DEFAULT NOW(), release_date TIMESTAMP, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL8 NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT REFERENCES Rose_db_object_private.vendors (id), status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP NOT NULL DEFAULT NOW(), release_date TIMESTAMP, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES Rose_db_object_private.products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.colors ( id BIGSERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.product_color_map ( product_id INT NOT NULL REFERENCES Rose_db_object_private.products (id), color_id INT NOT NULL REFERENCES Rose_db_object_private.colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; die "MySQL version too old" unless($db->database_version >= 4_000_000); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } # Foreign key stuff requires InnoDB support $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF # MySQL will silently ignore the "ENGINE=InnoDB" part and create # a MyISAM table instead. MySQL is evil! Now we have to manually # check to make sure an InnoDB table was really created. my $db_name = $db->database; my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?"); $sth->execute('vendors'); my $info = $sth->fetchrow_hashref; no warnings 'uninitialized'; unless(lc $info->{'Type'} eq 'innodb' || lc $info->{'Engine'} eq 'innodb') { die "Missing InnoDB support"; } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE products ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT, status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP, release_date TIMESTAMP, UNIQUE(name), INDEX(vendor_id), FOREIGN KEY (vendor_id) REFERENCES vendors (id) ON DELETE NO ACTION ON UPDATE SET NULL ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INT AUTO_INCREMENT PRIMARY KEY, product_id INT NOT NULL, region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region), INDEX(product_id), FOREIGN KEY (product_id) REFERENCES products (id) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL, color_id INT NOT NULL, PRIMARY KEY(product_id, color_id), INDEX(color_id), INDEX(product_id), FOREIGN KEY (product_id) REFERENCES products (id), FOREIGN KEY (color_id) REFERENCES colors (id) ) ENGINE=InnoDB EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) DEFAULT 'inactive' NOT NULL CHECK(status IN ('inactive', 'active', 'defunct')), date_created DATETIME YEAR TO SECOND, release_date DATETIME YEAR TO SECOND, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) DEFAULT 'inactive' NOT NULL CHECK(status IN ('inactive', 'active', 'defunct')), date_created DATETIME, release_date DATETIME, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INTEGER PRIMARY KEY AUTOINCREMENT, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } } END { File::Path::rmtree($Module_Dir) if(-d $Module_Dir); # Delete test tables Rose::DB->registry($real_registry); if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.product_color_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if($Have{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if($Have{'sqlite'}) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-loader-6.t000755 000765 000120 00000042306 12023202134 020071 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use File::Spec; use File::Path; use FindBin qw($Bin); use Test::More tests => 1 + (5 * 18); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Loader'); } our %Have; our @Tables = qw(vendors products prices colors product_color_map); our $Include_Tables = join('|', @Tables); our $Module_Dir = File::Spec->catfile($Bin, 'loader_lib'); SETUP: { File::Path::rmtree($Module_Dir) if(-d $Module_Dir); unless(-d $Module_Dir) { mkdir($Module_Dir); unless(-d $Module_Dir) { die "Could not mkdir($Module_Dir) - $!"; } } unshift(@INC, $Module_Dir); } # # Tests # # We'll need to clear the registry since we're using DSN instead our $real_registry = Rose::DB->registry; our $empty_registry = Rose::DB::Registry->new; my $i = 1; my $BC_Counter = 1; foreach my $db_type (qw(mysql pg_with_schema pg informix sqlite)) { SKIP: { skip("$db_type tests", 18) unless($Have{$db_type}); } next unless($Have{$db_type}); $i++; Rose::DB->registry($real_registry); Rose::DB::Object::Metadata->unregister_all_classes; my $class_prefix = ucfirst($db_type eq 'pg_with_schema' ? 'pgws' : $db_type); #$Rose::DB::Object::Metadata::Debug = 1; my $db = Rose::DB->new($db_type); my $loader = Rose::DB::Object::Loader->new( db_dsn => $db->dsn, db_schema => $db->schema, db_username => $db->username, db_password => $db->password, class_prefix => $class_prefix); Rose::DB->registry($empty_registry); my @classes = $loader->make_modules(include_tables => $Include_Tables, module_dir => $Module_Dir); if($db_type eq 'pg') { is(Pg::Color->meta->column('id')->perl_hash_definition, q(id => { type => 'bigserial', not_null => 1 }), "bigserial perl_hash_definition 1 - $db_type"); is(Pg::Price->meta->column('id')->perl_hash_definition, q(id => { type => 'serial', not_null => 1 }), "bigserial perl_hash_definition 2 - $db_type"); is(Pg::Product->meta->column('date_created')->type, 'timestamp', "tough default 1 - $db_type"); is(Pg::Product->meta->column('date_created')->default, 'now', "tough default 2 - $db_type"); } elsif($db_type eq 'pg_with_schema') { is(Pgws::Color->meta->column('id')->perl_hash_definition, q(id => { type => 'bigserial', not_null => 1 }), "bigserial perl_hash_definition 1 - $db_type"); is(Pgws::Price->meta->column('id')->perl_hash_definition, q(id => { type => 'serial', not_null => 1 }), "bigserial perl_hash_definition 2 - $db_type"); is(Pgws::Product->meta->column('date_created')->type, 'timestamp', "tough default 1 - $db_type"); is(Pgws::Product->meta->column('date_created')->default, 'now', "tough default 2 - $db_type"); } else { SKIP: { skip('Pg serial tests', 4); } } foreach my $class (@classes, map { $class_prefix . "::$_" } ('DB::AutoBase' . $BC_Counter, 'DB::Object::AutoBase' . ($BC_Counter + 1))) { my @path = split('::', $class); $path[-1] .= '.pm'; my $file = File::Spec->catfile($Module_Dir, @path); die "Missing $file" unless(-e $file, "make_modules() $class"); } $BC_Counter += 2; my $product_class = $class_prefix . '::Product'; ## ## Run tests ## my $p = $product_class->new(name => "Sled $i"); #ok($p->db->class =~ /^${class_prefix}::DB::AutoBase\d+$/, "db 1 - $db_type"); ok($p->isa('Rose::DB::Object'), "base class 1 - $db_type"); if($db_type eq 'pg_with_schema') { is($p->db->schema, lc 'Rose_db_object_private', "schema - $db_type"); } else { ok(1, "schema - $db_type"); } $p->vendor(name => "Acme $i"); $p->prices({ price => 1.25, region => 'US' }, { price => 4.25, region => 'UK' }); $p->colors({ name => 'red' }, { name => 'green' }); $p->save; system($^X, '-I', $Module_Dir, "-M$product_class", '-e', "\$p = $product_class->new(id => " . $p->id . ')->load;' . 'die "Wrong id" unless($p->name eq "' . $p->name . '");'); is($? >> 8, 0, "external load - $db_type"); $p = $product_class->new(id => $p->id)->load; is($p->vendor->name, "Acme $i", "vendor 1 - $db_type"); my @prices = sort { $a->price <=> $b->price } $p->prices; is(scalar @prices, 2, "prices 1 - $db_type"); is($prices[0]->price, 1.25, "prices 2 - $db_type"); is($prices[1]->price, 4.25, "prices 3 - $db_type"); my @colors = sort { $a->name cmp $b->name } $p->colors; is(scalar @colors, 2, "colors 1 - $db_type"); is($colors[0]->name, 'green', "colors 2 - $db_type"); is($colors[1]->name, 'red', "colors 3 - $db_type"); my $mgr_class = $class_prefix . '::Product::Manager'; my $prods = $mgr_class->get_products(query => [ id => $p->id ]); is(ref $prods, 'ARRAY', "get_products 1 - $db_type"); is(@$prods, 1, "get_products 2 - $db_type"); is($prods->[0]->id, $p->id, "get_products 3 - $db_type"); #$DB::single = 1; #$Rose::DB::Object::Debug = 1; my $vc = $class_prefix . '::Vendor'; my $sql = Rose::DB::Object::Manager->get_objects_sql( object_class => $vc, with_objects => [ 'products' ], query => [ 'products.vendor_id' => undef ]); if($db_type eq 'sqlite') { ok($sql =~ /WHERE \s+ t2\.vendor_id \s+ IS \s+ NULL \s+ ORDER \s+ BY/xi, "spot-check SQL generation - $db_type"); } else { ok(1, "skip spot-check SQL generation - $db_type") } } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.product_color_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP WITHOUT TIME ZONE NOT NULL DEFAULT ('now'::text)::timestamp(0) WITHOUT TIME ZONE, release_date TIMESTAMP, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL8 NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT REFERENCES Rose_db_object_private.vendors (id), status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP WITHOUT TIME ZONE NOT NULL DEFAULT ('now'::text)::timestamp(0) WITHOUT TIME ZONE, release_date TIMESTAMP, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES Rose_db_object_private.products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.colors ( id BIGSERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.product_color_map ( product_id INT NOT NULL REFERENCES Rose_db_object_private.products (id), color_id INT NOT NULL REFERENCES Rose_db_object_private.colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; die "MySQL version too old" unless($db->database_version >= 4_000_000); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } # Foreign key stuff requires InnoDB support $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF # MySQL will silently ignore the "ENGINE=InnoDB" part and create # a MyISAM table instead. MySQL is evil! Now we have to manually # check to make sure an InnoDB table was really created. my $db_name = $db->database; my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?"); $sth->execute('vendors'); my $info = $sth->fetchrow_hashref; no warnings 'uninitialized'; unless(lc $info->{'Type'} eq 'innodb' || lc $info->{'Engine'} eq 'innodb') { die "Missing InnoDB support"; } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE products ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT, status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP, release_date TIMESTAMP, UNIQUE(name), INDEX(vendor_id), FOREIGN KEY (vendor_id) REFERENCES vendors (id) ON DELETE NO ACTION ON UPDATE SET NULL ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INT AUTO_INCREMENT PRIMARY KEY, product_id INT NOT NULL, region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region), INDEX(product_id), FOREIGN KEY (product_id) REFERENCES products (id) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL, color_id INT NOT NULL, PRIMARY KEY(product_id, color_id), INDEX(color_id), INDEX(product_id), FOREIGN KEY (product_id) REFERENCES products (id), FOREIGN KEY (color_id) REFERENCES colors (id) ) ENGINE=InnoDB EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) DEFAULT 'inactive' NOT NULL CHECK(status IN ('inactive', 'active', 'defunct')), date_created DATETIME YEAR TO SECOND, release_date DATETIME YEAR TO SECOND, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) DEFAULT 'inactive' NOT NULL CHECK(status IN ('inactive', 'active', 'defunct')), date_created DATETIME, release_date DATETIME, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INTEGER PRIMARY KEY AUTOINCREMENT, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } } END { File::Path::rmtree($Module_Dir) if(-d $Module_Dir); # Delete test tables Rose::DB->registry($real_registry); if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.product_color_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if($Have{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if($Have{'sqlite'}) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-loader-7.t000755 000765 000120 00000040260 12103007040 020065 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 1 + (5 * 20); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Loader'); } our %Have; our @Tables = qw(vendor product price color product_color_map); our $Include_Tables = join('|', @Tables); SETUP: { package My::DB; our @ISA = qw(Rose::DB); package My::DB::Object::Metadata; our @ISA = qw(Rose::DB::Object::Metadata); sub make_column_methods { my($self) = shift; $JCS::Called_For{$self->class}++; $self->SUPER::make_column_methods(@_); } package My::DB::Object; our @ISA = qw(Rose::DB::Object); sub meta_class { 'My::DB::Object::Metadata' } sub foo_bar { 123 } package MyWeirdClass; our @ISA = qw(Rose::Object); sub baz { 456 } } # # Tests # # We'll need to clear the registry since we're using DSN instead our $real_registry = Rose::DB->registry; our $empty_registry = Rose::DB::Registry->new; my $i = 1; foreach my $db_type (qw(mysql pg_with_schema pg informix sqlite)) { SKIP: { skip("$db_type tests", 20) unless($Have{$db_type}); } next unless($Have{$db_type}); $i++; Rose::DB->registry($real_registry); Rose::DB::Object::Metadata->unregister_all_classes; my $class_prefix = ucfirst($db_type eq 'pg_with_schema' ? 'pgws' : $db_type); #$Rose::DB::Object::Metadata::Debug = 1; my $db = My::DB->new($db_type); my $loader = Rose::DB::Object::Loader->new( db_dsn => $db->dsn, db_schema => $db->schema, db_username => $db->username, db_password => $db->password, base_classes => [ qw(My::DB::Object MyWeirdClass) ], class_prefix => $class_prefix); # XXX: This is the important part of this test $loader->convention_manager->tables_are_singular(1); Rose::DB->registry($empty_registry); my @classes = $loader->make_classes(include_tables => $Include_Tables); #foreach my $class (@classes) #{ # print $class->meta->perl_class_definition if($class->can('meta')); #} my $product_class = $class_prefix . '::Product'; no warnings qw(redefine once); *My::DB::Object::init_db = sub { $db }; if($db_type =~ /^pg/) { is($product_class->meta->column('name_fk')->default, undef, "null default fk - $db_type"); is($product_class->meta->column('some_text')->type, 'text', "text column - $db_type"); } else { SKIP: { skip("null default fk - $db_type", 1) } SKIP: { skip("text column - $db_type", 1) } } ok($JCS::Called_For{$product_class}, "custom metadata - $db_type"); ## ## Run tests ## my $p = $product_class->new(name => "Sled $i"); #ok($p->db->class =~ /^${class_prefix}::DB::AutoBase\d+$/, "db 1 - $db_type"); ok($p->isa('My::DB::Object'), "base class 1 - $db_type"); ok($p->isa('MyWeirdClass'), "base class 2 - $db_type"); is($p->foo_bar, 123, "foo_bar 1 - $db_type"); is($p->baz, 456, "baz 1 - $db_type"); if($db_type eq 'pg_with_schema') { is($p->db->schema, lc 'Rose_db_object_private', "schema - $db_type"); } else { ok(1, "schema - $db_type"); } $p->vendor(name => "Acme $i"); $p->prices({ price => 1.25, region => 'US' }, { price => 4.25, region => 'UK' }); $p->colors({ name => 'red' }, { name => 'green' }); $p->save; $p = $product_class->new(id => $p->id)->load; is($p->vendor->name, "Acme $i", "vendor 1 - $db_type"); my @prices = sort { $a->price <=> $b->price } $p->prices; is(scalar @prices, 2, "prices 1 - $db_type"); is($prices[0]->price, 1.25, "prices 2 - $db_type"); is($prices[1]->price, 4.25, "prices 3 - $db_type"); my @colors = sort { $a->name cmp $b->name } $p->colors; is(scalar @colors, 2, "colors 1 - $db_type"); is($colors[0]->name, 'green', "colors 2 - $db_type"); is($colors[1]->name, 'red', "colors 3 - $db_type"); my $mgr_class = $class_prefix . '::Product::Manager'; my $prods = $mgr_class->get_products(query => [ id => $p->id ]); is(ref $prods, 'ARRAY', "get_products 1 - $db_type"); is(@$prods, 1, "get_products 2 - $db_type"); is($prods->[0]->id, $p->id, "get_products 3 - $db_type"); if($db_type eq 'pg') { # Check for float bug fixed in 0.761 $prods->[0]->num(37.3053); # dies with "value too long" in <0.761 } SKIP: { skip('MySQL tests', 2) if($db_type ne 'mysql'); is($product_class->meta->column('smint')->type, 'integer', "small int - $db_type"); is($product_class->meta->column('medint')->type, 'integer', "medium int - $db_type"); } #$DB::single = 1; #$Rose::DB::Object::Debug = 1; } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE color CASCADE'); $dbh->do('DROP TABLE price CASCADE'); $dbh->do('DROP TABLE product CASCADE'); $dbh->do('DROP TABLE vendor CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.product_color_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.color CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.price CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.product CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendor CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); } $dbh->do(<<"EOF"); CREATE TABLE vendor ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT REFERENCES vendor (id), name_fk VARCHAR(255) REFERENCES product (name), status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), num float(4), date_created TIMESTAMP NOT NULL DEFAULT NOW(), release_date TIMESTAMP, some_text TEXT, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE price ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES product (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE color ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES product (id), color_id INT NOT NULL REFERENCES color (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.vendor ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.product ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT REFERENCES Rose_db_object_private.vendor (id), name_fk VARCHAR(255) DEFAULT NULL REFERENCES product (name), status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), num float(4), date_created TIMESTAMP NOT NULL DEFAULT NOW(), release_date TIMESTAMP, some_text TEXT, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.price ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES Rose_db_object_private.product (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.color ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.product_color_map ( product_id INT NOT NULL REFERENCES Rose_db_object_private.product (id), color_id INT NOT NULL REFERENCES Rose_db_object_private.color (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; die "MySQL version too old" unless($db->database_version >= 4_000_000); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE color CASCADE'); $dbh->do('DROP TABLE price CASCADE'); $dbh->do('DROP TABLE product CASCADE'); $dbh->do('DROP TABLE vendor CASCADE'); } # Foreign key stuff requires InnoDB support $dbh->do(<<"EOF"); CREATE TABLE vendor ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF # MySQL will silently ignore the "ENGINE=InnoDB" part and create # a MyISAM table instead. MySQL is evil! Now we have to manually # check to make sure an InnoDB table was really created. my $db_name = $db->database; my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?"); $sth->execute('vendor'); my $info = $sth->fetchrow_hashref; no warnings 'uninitialized'; unless(lc $info->{'Type'} eq 'innodb' || lc $info->{'Engine'} eq 'innodb') { die "Missing InnoDB support"; } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE product ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, smint SMALLINT, medint MEDIUMINT, vendor_id INT, status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP, release_date TIMESTAMP, UNIQUE(name), INDEX(vendor_id), FOREIGN KEY (vendor_id) REFERENCES vendor (id) ON DELETE NO ACTION ON UPDATE SET NULL ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE price ( id INT AUTO_INCREMENT PRIMARY KEY, product_id INT NOT NULL, region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region), INDEX(product_id), FOREIGN KEY (product_id) REFERENCES product (id) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE color ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL, color_id INT NOT NULL, PRIMARY KEY(product_id, color_id), INDEX(color_id), INDEX(product_id), FOREIGN KEY (product_id) REFERENCES product (id), FOREIGN KEY (color_id) REFERENCES color (id) ) ENGINE=InnoDB EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE color CASCADE'); $dbh->do('DROP TABLE price CASCADE'); $dbh->do('DROP TABLE product CASCADE'); $dbh->do('DROP TABLE vendor CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE vendor ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, vendor_id INT REFERENCES vendor (id), status VARCHAR(128) DEFAULT 'inactive' NOT NULL CHECK(status IN ('inactive', 'active', 'defunct')), date_created DATETIME YEAR TO SECOND, release_date DATETIME YEAR TO SECOND, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE price ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES product (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE color ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES product (id), color_id INT NOT NULL REFERENCES color (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map'); $dbh->do('DROP TABLE color'); $dbh->do('DROP TABLE price'); $dbh->do('DROP TABLE product'); $dbh->do('DROP TABLE vendor'); } $dbh->do(<<"EOF"); CREATE TABLE vendor ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, vendor_id INT REFERENCES vendor (id), status VARCHAR(128) DEFAULT 'inactive' NOT NULL CHECK(status IN ('inactive', 'active', 'defunct')), date_created DATETIME, release_date DATETIME, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE price ( id INTEGER PRIMARY KEY AUTOINCREMENT, product_id INT NOT NULL REFERENCES product (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE color ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES product (id), color_id INT NOT NULL REFERENCES color (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } } END { # Delete test table Rose::DB->registry($real_registry); if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE color CASCADE'); $dbh->do('DROP TABLE price CASCADE'); $dbh->do('DROP TABLE product CASCADE'); $dbh->do('DROP TABLE vendor CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.product_color_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.color CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.price CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.product CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendor CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE color CASCADE'); $dbh->do('DROP TABLE price CASCADE'); $dbh->do('DROP TABLE product CASCADE'); $dbh->do('DROP TABLE vendor CASCADE'); $dbh->disconnect; } if($Have{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE color CASCADE'); $dbh->do('DROP TABLE price CASCADE'); $dbh->do('DROP TABLE product CASCADE'); $dbh->do('DROP TABLE vendor CASCADE'); $dbh->disconnect; } if($Have{'sqlite'}) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map'); $dbh->do('DROP TABLE color'); $dbh->do('DROP TABLE price'); $dbh->do('DROP TABLE product'); $dbh->do('DROP TABLE vendor'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-loader-8.t000755 000765 000120 00000007410 11653604702 020107 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 2 + (1 * 1); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB'); use_ok('Rose::DB::Object::Loader'); } our %Have; our @Tables = qw(attribute_types datatypes); our $Include_Tables = join('|', @Tables); # # Tests # my $i = 1; foreach my $db_type (qw(mysql)) { SKIP: { skip("$db_type tests", 1) unless($Have{$db_type}); } next unless($Have{$db_type}); $i++; my $class_prefix = ucfirst($db_type); #$Rose::DB::Object::Metadata::Debug = 1; my $db = Rose::DB->new($db_type); my $loader = Rose::DB::Object::Loader->new( db => $db, class_prefix => $class_prefix); # This call used to die prior to 0.7663 my @classes = $loader->make_classes(include_tables => $Include_Tables); is(scalar @classes, 4, "make_classes - $db_type"); #foreach my $class (@classes) #{ # if($class->can('meta')) # { # print $class->meta->perl_class_definition; # } # else # { # print $class->perl_class_definition; # } #} #$DB::single = 1; #$Rose::DB::Object::Debug = 1; } BEGIN { our %Have; my $dbh; # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; die "MySQL version too old" unless($db->database_version >= 4_000_000); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('ALTER TABLE attribute_types DROP FOREIGN KEY attribute_types_ibfk_1'); $dbh->do('ALTER TABLE datatypes DROP FOREIGN KEY datatypes_ibfk_1'); $dbh->do('DROP TABLE attribute_types CASCADE'); $dbh->do('DROP TABLE datatypes CASCADE'); } # Foreign key stuff requires InnoDB support $dbh->do(<<"EOF"); CREATE TABLE attribute_types ( id BIGINT(20) UNSIGNED NOT NULL auto_increment, name VARCHAR(255) NOT NULL, table_name VARCHAR(255) NOT NULL, datatype_id BIGINT(20) UNSIGNED NOT NULL, PRIMARY KEY (id), KEY name (name), KEY datatype_id (datatype_id) ) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=1 EOF # MySQL will silently ignore the "ENGINE=InnoDB" part and create # a MyISAM table instead. MySQL is evil! Now we have to manually # check to make sure an InnoDB table was really created. my $db_name = $db->database; my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?"); $sth->execute('attribute_types'); my $info = $sth->fetchrow_hashref; no warnings 'uninitialized'; unless(lc $info->{'Type'} eq 'innodb' || lc $info->{'Engine'} eq 'innodb') { die "Missing InnoDB support"; } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE datatypes ( id BIGINT(20) UNSIGNED NOT NULL AUTO_INCREMENT, name VARCHAR(255) NOT NULL, format VARCHAR(255) NOT NULL default '.*', PRIMARY KEY (id), UNIQUE KEY name (name) ) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=1 EOF $dbh->do(<<"EOF"); ALTER TABLE attribute_types ADD CONSTRAINT attribute_types_ibfk_1 FOREIGN KEY (datatype_id) REFERENCES datatypes (id) EOF $dbh->do(<<"EOF"); ALTER TABLE datatypes ADD CONSTRAINT datatypes_ibfk_1 FOREIGN KEY (id) REFERENCES attribute_types (datatype_id) ON DELETE CASCADE ON UPDATE NO ACTION EOF $dbh->disconnect; } } END { # Delete test table if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('ALTER TABLE attribute_types DROP FOREIGN KEY attribute_types_ibfk_1'); $dbh->do('ALTER TABLE datatypes DROP FOREIGN KEY datatypes_ibfk_1'); $dbh->do('DROP TABLE attribute_types CASCADE'); $dbh->do('DROP TABLE datatypes CASCADE'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-loader-9.t000644 000765 000120 00000003237 12011207127 020075 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use FindBin qw($Bin); use lib "$Bin/lib"; use Test::More tests => 1 + (1 * 3); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Loader'); } our %Have; # # Tests # foreach my $db_type (qw(sqlite)) { SKIP: { skip("$db_type tests", 3) unless($Have{$db_type}); } next unless($Have{$db_type}); my $loader = Rose::DB::Object::Loader->new( db_class => 'My::DB::Opa', base_classes => 'My::DB::Opa::Object', class_prefix => "My::ModelDynamic::$db_type", include_tables => 'sites', ); my @classes = $loader->make_classes; is(join(',', sort @classes), "My::ModelDynamic::${db_type}::Site,My::ModelDynamic::${db_type}::Site::Manager", "make_classes - $db_type"); is("My::ModelDynamic::${db_type}::Site"->new->dbh, My::DB::Opa->new_or_cached->dbh, "dbh is cached - $db_type"); is(My::DB::Opa->connection_count, 1, "connection count - $db_type"); } BEGIN { our %Have; # # SQLite # my $dbh; eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE sites'); } $dbh->do(<<"EOF"); CREATE TABLE sites ( id INT(10) NOT NULL, host VARCHAR(45) DEFAULT NULL, PRIMARY KEY (id) ) EOF $dbh->disconnect; } } END { if($Have{'sqlite'}) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE sites'); $dbh->disconnect; } } 1; Rose-DB-Object-0.810/t/db-object-loader.t000755 000765 000120 00000070371 12247507354 017755 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 1 + (6 * 38) + 9; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Loader'); } our %Have; our @Tables = qw(vendors products prices colors products_colors); our $Include_Tables = join('|', @Tables, 'no_pk_test2?'); our %Reserved_Words; # # Tests # FOO: { package MyCM; @MyCM::ISA = qw(Rose::DB::Object::ConventionManager); sub auto_foreign_key_name { $JCS::Called_Custom_CM{$_[0]->parent->class}++; shift->SUPER::auto_foreign_key_name(@_); } } my $i = 1; foreach my $db_type (qw(mysql pg pg_with_schema informix sqlite oracle)) { SKIP: { unless($Have{$db_type}) { skip("$db_type tests", 38 + scalar @{$Reserved_Words{$db_type} ||= []}); } } next unless($Have{$db_type}); $i++; Rose::DB->default_type($db_type); Rose::DB::Object::Metadata->unregister_all_classes; my $class_prefix = ucfirst($db_type eq 'pg_with_schema' ? 'pgws' : $db_type); #$Rose::DB::Object::Metadata::Debug = 1; %JCS::Called_Custom_CM = (); my $pre_init_hook = 0; my $db = Rose::DB->new; my $loader = Rose::DB::Object::Loader->new( db => $db, class_prefix => $class_prefix, ($db_type eq 'mysql' ? (require_primary_key => 0) : ()), pre_init_hook => sub { $pre_init_hook++ }); my %extra_loader_args; if($db_type eq 'sqlite') { $loader->warn_on_missing_primary_key(0); $loader->warn_on_missing_pk(1); } elsif($db_type eq 'pg') { $loader->include_predicated_unique_indexes(1); } elsif($db_type eq 'mysql') { $loader->warn_on_missing_pk(0); $loader->warn_on_missing_primary_key(1); $extra_loader_args{'warn_on_missing_pk'} = undef; $extra_loader_args{'warn_on_missing_primary_key'} = undef; } $loader->convention_manager($i % 2 ? 'MyCM' : MyCM->new); my @classes; my $i = 0; # Test aliased parameter conflicts foreach my $a (0, 1, undef) { foreach my $b (0, 1, undef) { if(($a || 0) != ($b || 0)) { $i++; eval { $loader->make_classes(warn_on_missing_pk => $a, warn_on_missing_primary_key => $b); }; ok($@, "warn_on_missing_pk conflict $i - $db_type"); } } } CATCH_WARNINGS: { my $warnings; local $SIG{'__WARN__'} = sub { $warnings .= "@_\n" }; @classes = $loader->make_classes(include_tables => $Include_Tables . ($db_type eq 'mysql' ? '|read' : ''), %extra_loader_args); #foreach my $class (@classes) #{ # next unless($class->isa('Rose::DB::Object')); # print $class->meta->perl_class_definition, "\n"; #} if($db_type eq 'sqlite') { ok($warnings =~ /\QWarning: table 'no_pk_test' has no primary key defined. Skipping./, "warn_on_missing_primary_key - $db_type"); } else { is($warnings, undef, "warn_on_missing_primary_key - $db_type"); } } ok(scalar keys %JCS::Called_Custom_CM >= 3, "custom convention manager - $db_type"); ok($pre_init_hook > 0, "pre_init_hook - $db_type"); if($db_type eq 'informix') { foreach my $class (@classes) { next unless($class->isa('Rose::DB::Object')); $class->meta->allow_inline_column_values(1); if($class->meta->column('release_day')) { is($class->meta->column('release_day')->type, 'datetime year to month', "datetime year to month - $db_type"); } } } else { ok(1, "skip datetime year to month - $db_type"); } if(defined Rose::DB->new->schema) { ok(!scalar(grep { /NoPk2/i } @classes), "pk classes only - $db_type"); } else { if($db_type eq 'mysql') { ok(1, "pk classes - $db_type"); } else { ok(!scalar(grep { /NoPk\b/i } @classes), "pk classes only - $db_type"); } } my $product_class = $class_prefix . '::Product'; my $price_class = $class_prefix . '::Price'; my $map_manager_class = $class_prefix . '::ProductsColor::Manager'; ## ## Run tests ## if($db_type =~ /^(?:mysql|pg|sqlite)$/) { my $serial = ($db_type ne 'mysql' || $db->dbh->{'Driver'}{'Version'} >= 4.002) ? 'serial' : 'integer'; is($product_class->meta->column('id')->type, $serial, "serial column - $db_type"); } else { SKIP: { skip("serial coercion test for $db_type", 1) } } if($db_type eq 'pg') { my $uk = $product_class->meta->unique_key_by_name('products_uk_test'); ok($uk && $uk->has_predicate, "include unique index with predicate - $db_type"); } elsif($db_type eq 'pg_with_schema') { my $uk = $product_class->meta->unique_key_by_name('products_uk_test'); ok(!$uk, "skip unique index with predicate - $db_type"); } else { SKIP: { skip("unique index with predicate for $db_type", 1) } } if($db_type eq 'pg') { is($product_class->meta->column('release_date')->type, 'timestamp', "timestamp - $db_type"); is($product_class->meta->column('release_date_tz')->type, 'timestamp with time zone', "timestamp with time zone - $db_type"); } else { SKIP: { skip("timestamp with time zone tests for $db_type", 2) } } if($db_type eq 'mysql' && $db->dbh->{'Driver'}{'Version'} >= 4.002) { is($price_class->meta->column('id')->type, 'bigserial', "bigserial column - $db_type"); } else { SKIP: { skip("bigserial test for $db_type", 1) } } if($db_type eq 'Pg') { is($price_class->meta->column('price')->precision, 10, "decimal precision - $db_type"); is($price_class->meta->column('price')->scale, 2, "decimal scale - $db_type"); } else { SKIP: { skip("decimal precision and scale - $db_type yet", 2) } } if($db_type eq 'informix' || $db_type eq 'oracle') { SKIP: { skip("count distinct multi-pk doesn't work in \u$db_type yet", 1) } } else { my $count = $map_manager_class->get_objects_count(require_objects => [ 'color' ]); is($count, 0, "count distinct multi-pk - $db_type"); } my $p = $product_class->new(name => "Sled $i"); if($p->can('release_day')) { $p->release_day('2001-02'); die "datetime year to month not truncated" unless($p->release_day->day == 1); $p->release_day('2001-02-05'); die "datetime year to month not truncated" unless($p->release_day->day == 1); } # Check reserved methods foreach my $word (@{$Reserved_Words{$db_type} ||= []}) { ok($p->$word(int(rand(10)) + 1), "reserved word: $word - $db_type"); } is($p->db->class, 'Rose::DB', "db 1 - $db_type"); if($db_type =~ /^pg/) { ok($p->can('tee_time') && $p->can('tee_time5'), "time methods - $db_type"); is($p->meta->column('tee_time5')->scale, 5, "time precision check 1 - $db_type"); is($p->meta->column('tee_time')->scale || 0, 0, "time precision check 2 - $db_type"); my $t = $p->tee_time5->as_string; $t =~ s/0+$//; is($p->tee_time5->as_string, '12:34:56.12345', "time default 1 - $db_type"); $t = $p->meta->column('tee_time5')->default; $t =~ s/0+$//; is($t, '12:34:56.12345', "time default 2 - $db_type"); is($price_class->meta->column('mprice')->length, undef, "money 1 - $db_type"); } elsif($db_type eq 'informix') { ok(!$p->can('tee_time') && !$p->can('tee_time5'), "time methods - $db_type"); ok(!$p->meta->column('tee_time5'), "time precision check 1 - $db_type"); ok(!$p->meta->column('tee_time'), "time precision check 2 - $db_type"); is($p->meta->column('bint1')->type, 'bigint', "bigint 1 - $db_type"); ok($p->bint1 =~ /^\+?9223372036854775800$/, "bigint 2 - $db_type"); SKIP: { skip("money tests - $db_type", 1) } } else { ok(!$p->can('tee_time') && !$p->can('tee_time5'), "time methods - $db_type"); ok(!$p->meta->column('tee_time5'), "time precision check 1 - $db_type"); ok(!$p->meta->column('tee_time'), "time precision check 2 - $db_type"); ok(1, "time default 1 - $db_type"); ok(1, "time default 2 - $db_type"); SKIP: { skip("money tests - $db_type", 1) } } OBJECT_CLASS: { no strict 'refs'; ok(${"${product_class}::ISA"}[0] =~ /^${class_prefix}::DB::Object::AutoBase\d+$/, "base class 1 - $db_type"); } $p->vendor(name => "Acme $i"); $p->prices({ price => 1.25, region => 'US' }, { price => 4.25, region => 'UK' }); $p->colors({ name => 'red' }, { name => 'green' }); $p->save; $p = $product_class->new(id => $p->id)->load; is($p->vendor->name, "Acme $i", "vendor 1 - $db_type"); my @prices = sort { $a->price <=> $b->price } $p->prices; is(scalar @prices, 2, "prices 1 - $db_type"); is($prices[0]->price, 1.25, "prices 2 - $db_type"); is($prices[1]->price, 4.25, "prices 3 - $db_type"); my @colors = sort { $a->name cmp $b->name } $p->colors; is(scalar @colors, 2, "colors 1 - $db_type"); is($colors[0]->name, 'green', "colors 2 - $db_type"); is($colors[1]->name, 'red', "colors 3 - $db_type"); my $mgr_class = $class_prefix . '::Product::Manager'; #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; my $prods = $mgr_class->get_products(query => [ id => $p->id ]); is(ref $prods, 'ARRAY', "get_products 1 - $db_type"); is(@$prods, 1, "get_products 2 - $db_type"); is($prods->[0]->id, $p->id, "get_products 3 - $db_type"); #$DB::single = 1; #local $Rose::DB::Object::Debug = 1; # Reserved tablee name tests if($db_type eq 'mysql') { my $o = Mysql::Read->new(read => 'Foo')->save; $o = Mysql::Read->new(id => $o->id)->load; is($o->read, 'Foo', "reserved table name 1 - $db_type"); my $os = Mysql::Read::Manager->get_read; ok(@$os == 1 && $os->[0]->read eq 'Foo', "reserved table name 2 - $db_type"); ok(Mysql::NoPkTest->isa('Rose::DB::Object'), "require_primary_key 1 - $db_type") } else { SKIP: { skip("reserved table name and no pk tests", 3); } } } BEGIN { our %Have; our %Reserved_Words = ( 'pg' => [ qw(role cast user) ], 'pg_with_schema' => [ qw(role cast user) ], 'mysql' => [ qw(read for case) ], ); # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE no_pk_test CASCADE'); $dbh->do('DROP TABLE no_pk_test2 CASCADE'); $dbh->do('DROP TABLE products_colors CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.no_pk_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.no_pk_test2 CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products_colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); } $dbh->do(<<"EOF"); CREATE TABLE no_pk_test ( id SERIAL NOT NULL, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE no_pk_test2 ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, @{[ join(', ', map { qq("$_" INT) } @{$Reserved_Words{'pg'}}) . ',' ]} vendor_id INT REFERENCES vendors (id), status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), tee_time TIME, tee_time5 TIME(5) DEFAULT '12:34:56.12345', date_created TIMESTAMP NOT NULL DEFAULT NOW(), release_date TIMESTAMP, release_date_tz TIMESTAMP WITH TIME ZONE, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE UNIQUE INDEX products_uk_test ON products (date_created) WHERE status = 'inactive'; EOF $dbh->do(<<"EOF"); CREATE UNIQUE INDEX products_uk1 ON products (LOWER(name)) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, mprice MONEY, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products_colors ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.no_pk_test ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.no_pk_test2 ( id SERIAL NOT NULL, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, @{[ join(', ', map { qq("$_" INT) } @{$Reserved_Words{'pg'}}) . ',' ]} vendor_id INT REFERENCES vendors (id), status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), tee_time TIME, tee_time5 TIME(5) DEFAULT '12:34:56.12345', date_created TIMESTAMP NOT NULL DEFAULT NOW(), release_date TIMESTAMP, release_date_tz TIMESTAMP WITH TIME ZONE, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE UNIQUE INDEX products_uk_test ON Rose_db_object_private.products (date_created) WHERE status = 'inactive'; EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, mprice MONEY, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.products_colors ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; die "MySQL version too old" unless($db->database_version >= 4_000_000); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE no_pk_test CASCADE'); $dbh->do('DROP TABLE products_colors CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE `read` CASCADE'); } # Foreign key stuff requires InnoDB support $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF # MySQL will silently ignore the "ENGINE=InnoDB" part and create # a MyISAM table instead. MySQL is evil! Now we have to manually # check to make sure an InnoDB table was really created. my $db_name = $db->database; my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?"); $sth->execute('vendors'); my $info = $sth->fetchrow_hashref; no warnings 'uninitialized'; unless(lc $info->{'Type'} eq 'innodb' || lc $info->{'Engine'} eq 'innodb') { die "Missing InnoDB support"; } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE no_pk_test ( id INT NOT NULL, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, @{[ join(', ', map { "`$_` INT" } @{$Reserved_Words{'mysql'}}) . ',' ]} vendor_id INT, status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP, release_date TIMESTAMP, UNIQUE(name), INDEX(vendor_id), FOREIGN KEY (vendor_id) REFERENCES vendors (id) ON DELETE NO ACTION ON UPDATE SET NULL ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id BIGINT AUTO_INCREMENT PRIMARY KEY, product_id INT NOT NULL, region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region), INDEX(product_id), FOREIGN KEY (product_id) REFERENCES products (id) ON UPDATE NO ACTION ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE products_colors ( product_id INT NOT NULL, color_id INT NOT NULL, PRIMARY KEY(product_id, color_id), INDEX(color_id), INDEX(product_id), FOREIGN KEY (product_id) REFERENCES products (id) ON DELETE NO ACTION, FOREIGN KEY (color_id) REFERENCES colors (id) ON UPDATE NO ACTION ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE `read` ( id INT AUTO_INCREMENT PRIMARY KEY, `read` VARCHAR(255) NOT NULL ) ENGINE=InnoDB EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE no_pk_test CASCADE'); $dbh->do('DROP TABLE products_colors CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE no_pk_test ( id INT NOT NULL, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) DEFAULT 'inactive' NOT NULL CHECK(status IN ('inactive', 'active', 'defunct')), rint1 INT, bint1 INT8 DEFAULT 9223372036854775800, date_created DATETIME YEAR TO SECOND, release_date DATETIME YEAR TO SECOND, release_day DATETIME YEAR TO MONTH, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products_colors ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE no_pk_test'); $dbh->do('DROP TABLE products_colors'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); } $dbh->do(<<"EOF"); CREATE TABLE 'no_pk_test' ( id INT NOT NULL, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE "vendors" ( "id" INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE("name") ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) DEFAULT 'inactive' NOT NULL CHECK(status IN ('inactive', 'active', 'defunct')), date_created DATETIME NOT NULL DEFAULT CURRENT_TIMESTAMP, release_date DATETIME, UNIQUE('name') ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INTEGER PRIMARY KEY AUTOINCREMENT, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products_colors ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # Oracle # eval { $dbh = Rose::DB->new('oracle_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'oracle'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE no_pk_test'); $dbh->do('DROP TABLE products_colors'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); $dbh->do('DROP SEQUENCE vendors_id_seq'); $dbh->do('DROP SEQUENCE products_id_seq'); $dbh->do('DROP SEQUENCE prices_id_seq'); $dbh->do('DROP SEQUENCE colors_id_seq'); } $dbh->do(<<"EOF"); CREATE TABLE no_pk_test ( id INT NOT NULL, name VARCHAR(255) NOT NULL, CONSTRAINT no_pk_test_name UNIQUE (name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INT NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, CONSTRAINT vendors_name UNIQUE (name) ) EOF $dbh->do('CREATE SEQUENCE vendors_id_seq'); $dbh->do(<<"EOF"); CREATE OR REPLACE TRIGGER vendors_insert BEFORE INSERT ON vendors FOR EACH ROW BEGIN SELECT NVL(:new.id, vendors_id_seq.nextval) INTO :new.id FROM dual; END; EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INT NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, vendor_id INT, status VARCHAR(128) DEFAULT 'inactive' NOT NULL CHECK(status IN ('inactive', 'active', 'defunct')), rint1 INT, bint1 NUMBER(20) DEFAULT 9223372036854775800, date_created TIMESTAMP, CONSTRAINT products_name UNIQUE (name), CONSTRAINT products_vendor_id_fk FOREIGN KEY (vendor_id) REFERENCES vendors (id) ) EOF $dbh->do('CREATE SEQUENCE products_id_seq'); $dbh->do(<<"EOF"); CREATE OR REPLACE TRIGGER products_insert BEFORE INSERT ON products FOR EACH ROW BEGIN SELECT NVL(:new.id, products_id_seq.nextval) INTO :new.id FROM dual; END; EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INT NOT NULL PRIMARY KEY, product_id INT NOT NULL, region CHAR(2) DEFAULT 'US' NOT NULL, price NUMBER(10,2) DEFAULT 0.00 NOT NULL, CONSTRAINT prices_uk UNIQUE (product_id, region), CONSTRAINT prices_product_id_fk FOREIGN KEY (product_id) REFERENCES products (id) ) EOF $dbh->do('CREATE SEQUENCE prices_id_seq'); $dbh->do(<<"EOF"); CREATE OR REPLACE TRIGGER prices_insert BEFORE INSERT ON prices FOR EACH ROW BEGIN SELECT NVL(:new.id, prices_id_seq.nextval) INTO :new.id FROM dual; END; EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INT NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, CONSTRAINT colors_name UNIQUE (name) ) EOF $dbh->do('CREATE SEQUENCE colors_id_seq'); $dbh->do(<<"EOF"); CREATE OR REPLACE TRIGGER colors_insert BEFORE INSERT ON colors FOR EACH ROW BEGIN SELECT NVL(:new.id, colors_id_seq.nextval) INTO :new.id FROM dual; END; EOF $dbh->do(<<"EOF"); CREATE TABLE products_colors ( product_id INT NOT NULL, color_id INT NOT NULL, CONSTRAINT products_colors_pk PRIMARY KEY (product_id, color_id), CONSTRAINT products_colors_product_id_fk FOREIGN KEY (product_id) REFERENCES products (id), CONSTRAINT products_colors_color_id_fk FOREIGN KEY (color_id) REFERENCES colors (id) ) EOF $dbh->disconnect; } } END { # Delete test table if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE no_pk_test CASCADE'); $dbh->do('DROP TABLE no_pk_test2 CASCADE'); $dbh->do('DROP TABLE products_colors CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.no_pk_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.no_pk_test2 CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products_colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE no_pk_test CASCADE'); $dbh->do('DROP TABLE products_colors CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE `read` CASCADE'); $dbh->disconnect; } if($Have{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE no_pk_test CASCADE'); $dbh->do('DROP TABLE products_colors CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if($Have{'sqlite'}) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE no_pk_test'); $dbh->do('DROP TABLE products_colors'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); $dbh->disconnect; } if($Have{'oracle'}) { # Informix my $dbh = Rose::DB->new('oracle_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE no_pk_test'); $dbh->do('DROP TABLE products_colors'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); $dbh->do('DROP SEQUENCE vendors_id_seq'); $dbh->do('DROP SEQUENCE products_id_seq'); $dbh->do('DROP SEQUENCE prices_id_seq'); $dbh->do('DROP SEQUENCE colors_id_seq'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-manager-bulk-ops.t000755 000765 000120 00000071075 12054157213 021644 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 218; BEGIN { require 't/test-lib.pl'; use_ok('DateTime'); use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Manager'); } our($HAVE_PG, $HAVE_MYSQL, $HAVE_INFORMIX, $HAVE_SQLITE); # # PostgreSQL # SKIP: foreach my $db_type (qw(pg pg_with_schema)) { skip("PostgreSQL tests", 92) unless($HAVE_PG); Rose::DB->default_type($db_type); # Test the subselect limit code #Rose::DB::Object::Manager->default_limit_with_subselect(1); TEST_HACK: { no warnings; *MyPgObject::init_db = sub { Rose::DB->new($db_type) }; } my $o = MyPgObject->new(name => 'John', code => 1, started => '1/1/2000', num => 10); ok($o->save, "save() 1 - $db_type"); $o = MyPgObject->new(name => 'Fred', code => 2, started => '1/2/1999', num => 20); ok($o->save, "save() 2 - $db_type"); $o = MyPgObject->new(name => 'Steve', code => 3, started => '1/3/1998', num => 30); ok($o->save, "save() 3 - $db_type"); $o = MyPgObject->new(name => 'Bud', code => 4, started => '1/4/1997', num => 40); ok($o->save, "save() 4 - $db_type"); $o = MyPgObject->new(name => 'Betty', code => 5, started => '1/5/1996', num => 50); ok($o->save, "save() 5 - $db_type"); my $now = DateTime->now; my $yesterday = $now->clone->subtract(days => 1); # Start update tests #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; my $num = MyPgObject::Manager->update_objs( set => { num => { sql => 'num + 1' }, code => 'foo', data => "\000\001\002", }, where => [ name => { like => 'NoneSuch%' }, started => { gt => [ $now, $yesterday, '1/1/2005' ] }, data => { ne => "\000\001\002" }, ]); ok(defined $num, "update 1 - $db_type"); ok($num == 0, "update 2 - $db_type"); is($num, '0', "update 3 - $db_type"); eval { $num = MyPgObject::Manager->update_objs( where => [ name => { like => 'NoneSuch%' }, started => { gt => [ $now, $yesterday, '1/1/2005' ] } ]); }; ok($@, "update missing set 1 - $db_type"); $num = MyPgObject::Manager->update_objs( set => { num => { sql => 'num + 1' }, }, where => [ name => { like => '%oh%' }, or => [ started => { lt => $now }, started => { lt => $yesterday }, started => { lt => '1/1/2005' }, ], ]); ok($num, "update 4 - $db_type"); ok($num == 1, "update 5 - $db_type"); is($num, 1, "update 6 - $db_type"); $o = MyPgObject->new(name => 'John'); $o->load; is($o->num, 11, "update verify 1 - $db_type"); $o = MyPgObject->new(name => 'Fred'); $o->load; is($o->num, 20, "update verify 2 - $db_type"); $o = MyPgObject->new(name => 'Steve'); $o->load; is($o->num, 30, "update verify 3 - $db_type"); $o = MyPgObject->new(name => 'Bud'); $o->load; is($o->num, 40, "update verify 4 - $db_type"); $o = MyPgObject->new(name => 'Betty'); $o->load; is($o->num, 50, "update verify 5 - $db_type"); eval { $num = MyPgObject::Manager->update_objs( set => { ended => DateTime->new(year => 1999, month => 2, day => 3), }); }; ok($@, "update refused - $db_type"); $num = MyPgObject::Manager->update_objs( all => 1, set => { data => "\000\001\003", ended => DateTime->new(year => 1999, month => 2, day => 3), }); ok($num, "update 7 - $db_type"); ok($num == 5, "update 8 - $db_type"); is($num, 5, "update 9 - $db_type"); my $objs = MyPgObject::Manager->get_objs; my $test_num = 6; foreach my $obj (@$objs) { ok($obj->ended->ymd eq '1999-02-03', "update verify date $test_num - $db_type"); ok($obj->data eq "\000\001\003", "update verify data $test_num - $db_type"); } # End update tests # Start delete tests $num = MyPgObject::Manager->delete_objs( where => [ name => { like => 'NoneSuch%' }, data => "\000\001\003", started => { gt => [ $now, $yesterday, '1/1/2005' ] } ]); ok(defined $num, "delete 1 - $db_type"); ok($num == 0, "delete 2 - $db_type"); is($num, '0', "delete 3 - $db_type"); $num = MyPgObject::Manager->delete_objs( where => [ name => { like => 'B%' }, started => { lt => 'now' }, ]); ok($num, "delete 4 - $db_type"); ok($num == 2, "delete 5 - $db_type"); is($num, 2, "delete 6 - $db_type"); $num = MyPgObject::Manager->delete_objs( where => [ name => { like => '%oh%' }, num => [ (1 .. 11) ], data => "\000\001\003", ]); ok($num, "delete 7 - $db_type"); ok($num == 1, "delete 8 - $db_type"); is($num, 1, "delete 9 - $db_type"); $num = MyPgObject::Manager->get_objs_count; is($num, 2, "count remaining 1 - $db_type"); eval { $num = MyPgObject::Manager->delete_objs }; ok($@, "delete refuse - $db_type"); $num = MyPgObject::Manager->delete_objs(all => 1); ok($num, "delete 10 - $db_type"); ok($num == 2, "delete 11 - $db_type"); is($num, 2, "delete 12 - $db_type"); $num = MyPgObject::Manager->get_objs_count; is($num, 0, "count remaining 2 - $db_type"); # End delete tests # End test of the subselect limit code #Rose::DB::Object::Manager->default_limit_with_subselect(0); } # # MySQL # SKIP: foreach my $db_type ('mysql') { skip("MySQL tests", 41) unless($HAVE_MYSQL); Rose::DB->default_type($db_type); my $o = MyMySQLObject->new(name => 'John', code => 1, started => '1/1/2000', num => 10); ok($o->save, "save() 1 - $db_type"); $o = MyMySQLObject->new(name => 'Fred', code => 2, started => '1/2/1999', num => 20); ok($o->save, "save() 2 - $db_type"); $o = MyMySQLObject->new(name => 'Steve', code => 3, started => '1/3/1998', num => 30); ok($o->save, "save() 3 - $db_type"); $o = MyMySQLObject->new(name => 'Bud', code => 4, started => '1/4/1997', num => 40); ok($o->save, "save() 4 - $db_type"); $o = MyMySQLObject->new(name => 'Betty', code => 5, started => '1/5/1996', num => 50); ok($o->save, "save() 5 - $db_type"); my $now = DateTime->now; my $yesterday = $now->clone->subtract(days => 1); # Start update tests #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; my $num = MyMySQLObject::Manager->update_objs( set => { num => { sql => 'num + 1' }, code => 'foo', }, where => [ name => { like => 'NoneSuch%' }, started => { gt => [ $now, $yesterday, '1/1/2005' ] } ]); ok(defined $num, "update 1 - $db_type"); ok($num == 0, "update 2 - $db_type"); is($num, '0', "update 3 - $db_type"); eval { $num = MyMySQLObject::Manager->update_objs( where => [ name => { like => 'NoneSuch%' }, started => { gt => [ $now, $yesterday, '1/1/2005' ] } ]); }; ok($@, "update missing set 1 - $db_type"); $num = MyMySQLObject::Manager->update_objs( set => { num => { sql => 'num + 1' }, }, where => [ name => { like => '%oh%' }, or => [ started => { lt => $now }, started => { lt => $yesterday }, started => { lt => '1/1/2005' }, ], ]); ok($num, "update 4 - $db_type"); ok($num == 1, "update 5 - $db_type"); is($num, 1, "update 6 - $db_type"); $o = MyMySQLObject->new(name => 'John'); $o->load; is($o->num, 11, "update verify 1 - $db_type"); $o = MyMySQLObject->new(name => 'Fred'); $o->load; is($o->num, 20, "update verify 2 - $db_type"); $o = MyMySQLObject->new(name => 'Steve'); $o->load; is($o->num, 30, "update verify 3 - $db_type"); $o = MyMySQLObject->new(name => 'Bud'); $o->load; is($o->num, 40, "update verify 4 - $db_type"); $o = MyMySQLObject->new(name => 'Betty'); $o->load; is($o->num, 50, "update verify 5 - $db_type"); eval { $num = MyMySQLObject::Manager->update_objs( set => { ended => DateTime->new(year => 1999, month => 2, day => 3), }); }; ok($@, "update refused - $db_type"); $num = MyMySQLObject::Manager->update_objs( all => 1, set => { ended => DateTime->new(year => 1999, month => 2, day => 3), }); ok($num, "update 7 - $db_type"); ok($num == 5, "update 8 - $db_type"); is($num, 5, "update 9 - $db_type"); my $objs = MyMySQLObject::Manager->get_objs; my $test_num = 6; foreach my $obj (@$objs) { ok($obj->ended->ymd eq '1999-02-03', "update verify $test_num - $db_type"); } # End update tests # Start delete tests $num = MyMySQLObject::Manager->delete_objs( where => [ name => { like => 'NoneSuch%' }, started => { gt => [ $now, $yesterday, '1/1/2005' ] } ]); ok(defined $num, "delete 1 - $db_type"); ok($num == 0, "delete 2 - $db_type"); is($num, '0', "delete 3 - $db_type"); $num = MyMySQLObject::Manager->delete_objs( where => [ name => { like => 'B%' }, started => { lt => 'now' }, ]); ok($num, "delete 4 - $db_type"); ok($num == 2, "delete 5 - $db_type"); is($num, 2, "delete 6 - $db_type"); $num = MyMySQLObject::Manager->delete_objs( where => [ name => { like => '%oh%' }, num => [ (1 .. 11) ], ]); ok($num, "delete 7 - $db_type"); ok($num == 1, "delete 8 - $db_type"); is($num, 1, "delete 9 - $db_type"); $num = MyMySQLObject::Manager->get_objs_count; is($num, 2, "count remaining 1 - $db_type"); eval { $num = MyMySQLObject::Manager->delete_objs }; ok($@, "delete refuse - $db_type"); $num = MyMySQLObject::Manager->delete_objs(all => 1); ok($num, "delete 10 - $db_type"); ok($num == 2, "delete 11 - $db_type"); is($num, 2, "delete 12 - $db_type"); $num = MyMySQLObject::Manager->get_objs_count; is($num, 0, "count remaining 2 - $db_type"); # End delete tests } # # Informix # SKIP: foreach my $db_type ('informix') { skip("Informix tests", 41) unless($HAVE_INFORMIX); Rose::DB->default_type($db_type); my $o = MyInformixObject->new(name => 'John', code => 1, started => '1/1/2000', num => 10); ok($o->save, "save() 1 - $db_type"); $o = MyInformixObject->new(name => 'Fred', code => 2, started => '1/2/1999', num => 20); ok($o->save, "save() 2 - $db_type"); $o = MyInformixObject->new(name => 'Steve', code => 3, started => '1/3/1998', num => 30); ok($o->save, "save() 3 - $db_type"); $o = MyInformixObject->new(name => 'Bud', code => 4, started => '1/4/1997', num => 40); ok($o->save, "save() 4 - $db_type"); $o = MyInformixObject->new(name => 'Betty', code => 5, started => '1/5/1996', num => 50); ok($o->save, "save() 5 - $db_type"); my $now = DateTime->now; my $yesterday = $now->clone->subtract(days => 1); # Start update tests #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; my $num = MyInformixObject::Manager->update_objs( set => { num => { sql => 'num + 1' }, code => 'foo', }, where => [ name => { like => 'NoneSuch%' }, started => { gt => [ $now, $yesterday, '1/1/2005' ] } ]); ok(defined $num, "update 1 - $db_type"); ok($num == 0, "update 2 - $db_type"); is($num, '0', "update 3 - $db_type"); eval { $num = MyInformixObject::Manager->update_objs( where => [ name => { like => 'NoneSuch%' }, started => { gt => [ $now, $yesterday, '1/1/2005' ] } ]); }; ok($@, "update missing set 1 - $db_type"); $num = MyInformixObject::Manager->update_objs( set => { num => { sql => 'num + 1' }, }, where => [ name => { like => '%oh%' }, or => [ started => { lt => $now }, started => { lt => $yesterday }, started => { lt => '1/1/2005' }, ], ]); ok($num, "update 4 - $db_type"); ok($num == 1, "update 5 - $db_type"); is($num, 1, "update 6 - $db_type"); $o = MyInformixObject->new(name => 'John'); $o->load; is($o->num, 11, "update verify 1 - $db_type"); $o = MyInformixObject->new(name => 'Fred'); $o->load; is($o->num, 20, "update verify 2 - $db_type"); $o = MyInformixObject->new(name => 'Steve'); $o->load; is($o->num, 30, "update verify 3 - $db_type"); $o = MyInformixObject->new(name => 'Bud'); $o->load; is($o->num, 40, "update verify 4 - $db_type"); $o = MyInformixObject->new(name => 'Betty'); $o->load; is($o->num, 50, "update verify 5 - $db_type"); eval { $num = MyInformixObject::Manager->update_objs( set => { ended => DateTime->new(year => 1999, month => 2, day => 3), }); }; ok($@, "update refused - $db_type"); $num = MyInformixObject::Manager->update_objs( all => 1, set => { ended => DateTime->new(year => 1999, month => 2, day => 3), }); ok($num, "update 7 - $db_type"); ok($num == 5, "update 8 - $db_type"); is($num, 5, "update 9 - $db_type"); my $objs = MyInformixObject::Manager->get_objs; my $test_num = 6; foreach my $obj (@$objs) { ok($obj->ended->ymd eq '1999-02-03', "update verify $test_num - $db_type"); } # End update tests # Start delete tests $num = MyInformixObject::Manager->delete_objs( where => [ name => { like => 'NoneSuch%' }, started => { gt => [ $now, $yesterday, '1/1/2005' ] } ]); ok(defined $num, "delete 1 - $db_type"); ok($num == 0, "delete 2 - $db_type"); is($num, '0', "delete 3 - $db_type"); $num = MyInformixObject::Manager->delete_objs( where => [ name => { like => 'B%' }, started => { lt => 'now' }, ]); ok($num, "delete 4 - $db_type"); ok($num == 2, "delete 5 - $db_type"); is($num, 2, "delete 6 - $db_type"); $num = MyInformixObject::Manager->delete_objs( where => [ name => { like => '%oh%' }, num => [ (1 .. 11) ], ]); ok($num, "delete 7 - $db_type"); ok($num == 1, "delete 8 - $db_type"); is($num, 1, "delete 9 - $db_type"); $num = MyInformixObject::Manager->get_objs_count; is($num, 2, "count remaining 1 - $db_type"); eval { $num = MyInformixObject::Manager->delete_objs }; ok($@, "delete refuse - $db_type"); $num = MyInformixObject::Manager->delete_objs(all => 1); ok($num, "delete 10 - $db_type"); ok($num == 2, "delete 11 - $db_type"); is($num, 2, "delete 12 - $db_type"); $num = MyInformixObject::Manager->get_objs_count; is($num, 0, "count remaining 2 - $db_type"); # End delete tests } # # SQLite # SKIP: foreach my $db_type ('sqlite') { skip("Informix tests", 41) unless($HAVE_SQLITE); Rose::DB->default_type($db_type); my $o = MySQLiteObject->new(name => 'John', code => 1, started => '1/1/2000', num => 10); ok($o->save, "save() 1 - $db_type"); $o = MySQLiteObject->new(name => 'Fred', code => 2, started => '1/2/1999', num => 20); ok($o->save, "save() 2 - $db_type"); $o = MySQLiteObject->new(name => 'Steve', code => 3, started => '1/3/1998', num => 30); ok($o->save, "save() 3 - $db_type"); $o = MySQLiteObject->new(name => 'Bud', code => 4, started => '1/4/1997', num => 40); ok($o->save, "save() 4 - $db_type"); $o = MySQLiteObject->new(name => 'Betty', code => 5, started => '1/5/1996', num => 50); ok($o->save, "save() 5 - $db_type"); my $now = DateTime->now; my $yesterday = $now->clone->subtract(days => 1); # Start update tests #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; my $num = MySQLiteObject::Manager->update_objs( set => { num => { sql => 'num + 1' }, code => 'foo', }, where => [ name => { like => 'NoneSuch%' }, started => { gt => [ $now, $yesterday, '1/1/2005' ] }, [ \q(rose_db_object_test.num % 2 == ?) => 0 ], ]); ok(defined $num, "update 1 - $db_type"); ok($num == 0, "update 2 - $db_type"); is($num, '0', "update 3 - $db_type"); eval { $num = MySQLiteObject::Manager->update_objs( where => [ name => { like => 'NoneSuch%' }, started => { gt => [ $now, $yesterday, '1/1/2005' ] } ]); }; ok($@, "update missing set 1 - $db_type"); $num = MySQLiteObject::Manager->update_objs( set => { num => { sql => 'num + 1' }, }, where => [ name => { like => '%oh%' }, or => [ started => { lt => $now }, started => { lt => $yesterday }, started => { lt => '1/1/2005' }, ], [ \q(rose_db_object_test.num % 2 != ?) => 0 ], ]); ok($num, "update 4 - $db_type"); ok($num == 1, "update 5 - $db_type"); is($num, 1, "update 6 - $db_type"); $o = MySQLiteObject->new(name => 'John'); $o->load; is($o->num, 11, "update verify 1 - $db_type"); $o = MySQLiteObject->new(name => 'Fred'); $o->load; is($o->num, 20, "update verify 2 - $db_type"); $o = MySQLiteObject->new(name => 'Steve'); $o->load; is($o->num, 30, "update verify 3 - $db_type"); $o = MySQLiteObject->new(name => 'Bud'); $o->load; is($o->num, 40, "update verify 4 - $db_type"); $o = MySQLiteObject->new(name => 'Betty'); $o->load; is($o->num, 50, "update verify 5 - $db_type"); eval { $num = MySQLiteObject::Manager->update_objs( set => { ended => DateTime->new(year => 1999, month => 2, day => 3), }); }; ok($@, "update refused - $db_type"); $num = MySQLiteObject::Manager->update_objs( all => 1, set => { ended => DateTime->new(year => 1999, month => 2, day => 3), }); ok($num, "update 7 - $db_type"); ok($num == 5, "update 8 - $db_type"); is($num, 5, "update 9 - $db_type"); my $objs = MySQLiteObject::Manager->get_objs; my $test_num = 6; foreach my $obj (@$objs) { ok($obj->ended->ymd eq '1999-02-03', "update verify $test_num - $db_type"); } # End update tests # Start delete tests $num = MySQLiteObject::Manager->delete_objs( where => [ name => { like => 'NoneSuch%' }, started => { gt => [ $now, $yesterday, '1/1/2005' ] } ]); ok(defined $num, "delete 1 - $db_type"); ok($num == 0, "delete 2 - $db_type"); is($num, '0', "delete 3 - $db_type"); $num = MySQLiteObject::Manager->delete_objs( where => [ name => { like => 'B%' }, started => { lt => 'now' }, ]); ok($num, "delete 4 - $db_type"); ok($num == 2, "delete 5 - $db_type"); is($num, 2, "delete 6 - $db_type"); $num = MySQLiteObject::Manager->delete_objs( where => [ name => { like => '%oh%' }, num => [ (1 .. 11) ], ]); ok($num, "delete 7 - $db_type"); ok($num == 1, "delete 8 - $db_type"); is($num, 1, "delete 9 - $db_type"); $num = MySQLiteObject::Manager->get_objs_count; is($num, 2, "count remaining 1 - $db_type"); eval { $num = MySQLiteObject::Manager->delete_objs }; ok($@, "delete refuse - $db_type"); $num = MySQLiteObject::Manager->delete_objs(all => 1); # $sth->rows is broken in DBD::SQLite # http://rt.cpan.org/NoAuth/Bug.html?id=16187 ok(2, "delete 10 - $db_type"); ok(2 == 2, "delete 11 - $db_type"); is(2, 2, "delete 12 - $db_type"); #ok($num, "delete 10 - $db_type"); #ok($num == 2, "delete 11 - $db_type"); #is($num, 2, "delete 12 - $db_type"); $num = MySQLiteObject::Manager->get_objs_count; is($num, 0, "count remaining 2 - $db_type"); # End delete tests } BEGIN { # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_PG = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->do('DROP TABLE rose_db_object_private.rose_db_object_test CASCADE'); $dbh->do('CREATE SCHEMA rose_db_object_private'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, code CHAR(6), started DATE, ended DATE, num INT, data BYTEA, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_private.rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, code CHAR(6), started DATE, ended DATE, num INT, data BYTEA, UNIQUE(name) ) EOF $dbh->disconnect; # Create test subclass package MyPgObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } MyPgObject->meta->table('rose_db_object_test'); MyPgObject->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', length => 32 }, code => { type => 'char', length => 6 }, started => { type => 'date', default => '12/24/1980' }, ended => { type => 'date', default => '1/1/2000' }, num => { type => 'int' }, data => { type => 'bytea' }, ); MyPgObject->meta->add_unique_key('name'); MyPgObject->meta->initialize; package MyPgObject::Manager; our @ISA = qw(Rose::DB::Object::Manager); sub object_class { 'MyPgObject' } MyPgObject::Manager->make_manager_methods('objs'); } # # MySQL # eval { $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_MYSQL = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, name VARCHAR(32) NOT NULL, code CHAR(6), started DATE, ended DATE, num INT, UNIQUE(name) ) EOF $dbh->disconnect; # Create test subclass package MyMySQLObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } MyMySQLObject->meta->table('rose_db_object_test'); MyMySQLObject->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', length => 32 }, code => { type => 'char', length => 6 }, started => { type => 'date', default => '12/24/1980' }, ended => { type => 'date', default => '1/1/2000' }, num => { type => 'int' }, ); MyMySQLObject->meta->add_unique_key('name'); MyMySQLObject->meta->initialize; package MyMySQLObject::Manager; our @ISA = qw(Rose::DB::Object::Manager); sub object_class { 'MyMySQLObject' } MyMySQLObject::Manager->make_manager_methods('objs'); } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_INFORMIX = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, code CHAR(6), started DATE, ended DATE, num INT, UNIQUE(name) ) EOF $dbh->disconnect; # Create test subclass package MyInformixObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('informix') } MyInformixObject->meta->table('rose_db_object_test'); MyInformixObject->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', length => 32 }, code => { type => 'char', length => 6 }, started => { type => 'date', default => '12/24/1980' }, ended => { type => 'date', default => '1/1/2000' }, num => { type => 'int' }, ); MyInformixObject->meta->add_unique_key('name'); MyInformixObject->meta->initialize; package MyInformixObject::Manager; our @ISA = qw(Rose::DB::Object::Manager); sub object_class { 'MyInformixObject' } MyInformixObject::Manager->make_manager_methods('objs'); } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_SQLITE = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(32) NOT NULL, code CHAR(6), started DATE, ended DATE, num INT, UNIQUE(name) ) EOF $dbh->disconnect; # Create test subclass package MySQLiteObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MySQLiteObject->meta->table('rose_db_object_test'); MySQLiteObject->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', length => 32 }, code => { type => 'char', length => 6 }, started => { type => 'date', default => '12/24/1980' }, ended => { type => 'date', default => '1/1/2000' }, num => { type => 'int' }, ); MySQLiteObject->meta->add_unique_key('name'); MySQLiteObject->meta->initialize; package MySQLiteObject::Manager; our @ISA = qw(Rose::DB::Object::Manager); sub object_class { 'MySQLiteObject' } MySQLiteObject::Manager->make_manager_methods('objs'); } } END { # Delete test table if($HAVE_PG) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->do('DROP TABLE rose_db_object_private.rose_db_object_test CASCADE'); $dbh->do('DROP SCHEMA rose_db_object_private CASCADE'); $dbh->disconnect; } if($HAVE_MYSQL) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->disconnect; } if($HAVE_INFORMIX) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->disconnect; } if($HAVE_SQLITE) { # SQLite my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-manager.t000755 000765 000120 00002255173 11607674331 020127 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 3910; BEGIN { require 't/test-lib.pl'; use_ok('DateTime'); use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Manager'); } use Rose::DateTime::Util qw(parse_date); CONVENTION_AND_DEFAULTS_TESTS: { package My::RDBO::CM; our @ISA = qw(Rose::DB::Object::ConventionManager); sub auto_manager_method_name { my($self, $type, $base_name, $object_class) = @_; if($type eq 'iterator') { return "get_${base_name}z_iter"; } elsif($type eq 'delete') { return "del_${base_name}zz"; } return undef; # rely on hard-coded defaults in Manager } sub auto_manager_class_name { my($self, $object_class) = @_; $object_class ||= $self->meta->class; return "${object_class}::Mgr"; } package My::RDBO::Meta; our @ISA = qw(Rose::DB::Object::Metadata); sub init_convention_manager { My::RDBO::CM->new } package My::RDBO::Manager; our @ISA = qw(Rose::DB::Object::Manager); __PACKAGE__->default_manager_method_types(qw(iterator count delete)); package My::RDBO::Test1; our @ISA = qw(Rose::DB::Object); __PACKAGE__->meta->table('test1s'); sub meta_class { 'My::RDBO::Meta' } __PACKAGE__->meta->default_manager_base_class('My::RDBO::Managerxx'); eval { local $SIG{'__DIE__'}; __PACKAGE__->meta->make_manager_class }; main::ok($@, 'make_manager_class exception 1'); __PACKAGE__->meta->default_manager_base_class('My::RDBO::Manager'); #local $Rose::DB::Object::Manager::Debug = 1; __PACKAGE__->meta->make_manager_class; package main; ok(My::RDBO::Test1::Mgr->can('get_test1sz_iter'), 'make_manager_class conventions 1'); ok(My::RDBO::Test1::Mgr->can('get_test1s_count'), 'make_manager_class conventions 2'); ok(My::RDBO::Test1::Mgr->can('del_test1szz'), 'make_manager_class conventions 3'); } our($HAVE_PG, $HAVE_MYSQL, $HAVE_INFORMIX, $HAVE_SQLITE, $HAVE_ORACLE); # XXX: TODO - outer join where fo is null if(defined $ENV{'RDBO_NESTED_JOINS'} && Rose::DB::Object::Manager->can('default_nested_joins')) { Rose::DB::Object::Manager->default_nested_joins($ENV{'RDBO_NESTED_JOINS'}); } # # PostgreSQL # SKIP: foreach my $db_type (qw(pg)) #pg_with_schema { skip("PostgreSQL tests", 784) unless($HAVE_PG); Rose::DB->default_type($db_type); # Test the subselect limit code #Rose::DB::Object::Manager->default_limit_with_subselect(1); my $db = MyPgObject->init_db; my $o = MyPgObject->new(db => $db, id => 1, name => 'John', flag => 't', flag2 => 'f', fkone => 2, status => 'active', bits => '00001', start => '2001-01-02', save_col => 5, nums => [ 1, 2, 3 ], data => "\000\001\002", last_modified => 'now', date_created => '2004-03-30 12:34:56'); ok($o->save, "object save() 1 - $db_type"); my $objs = MyPgObject->get_objectz( db => $db, share_db => 1, query_is_sql => 1, #debug => 1, where => [ id => { ge => 1 }, id => [ \'1', \'id' ], #' id => { gt_lt => [ -1, 991 ] }, id => { gt_le => [ -1, 992 ] }, id => { ge_lt => [ -1, 993 ] }, id => { ge_le => [ -1, 994 ] }, id => { gt_lt_sql => [ -1, 991 ] }, id => { gt_le_sql => [ -1, 992 ] }, id => { ge_lt_sql => [ -1, 993 ] }, id => { ge_le_sql => [ -1, 994 ] }, id => { gt_lt => [ -1, \991 ] }, id => { gt_le => [ \-1, 992 ] }, id => { ge_lt => [ -1, \993 ] }, id => { ge_le => [ \-1, 994 ] }, id => { between => [ 0, 99 ] }, id => { between => [ 0, \q(101) ] }, id => { between => [ \1, 99 ] }, id => { ne => undef }, name => 'John', flag => 't', flag2 => 'f', flag2 => { is => \q(false) }, flag2 => { is_not => \q(true) }, flag2 => { is_not => undef }, '!flag2' => { is => undef }, status => 'active', bits => '00001', fixed => { like => 'nee%' }, or => [ and => [ '!bits' => '00001', bits => { ne => '11111' } ], and => [ bits => { lt => '10101' }, '!bits' => '10000' ] ], start => '2001-01-02', start => { lt => \q('now'::date + interval '30 days') }, start => { between => [ '1/1/1999', 'now' ] }, start => { between_sql => [ "'1999-02-02'", "'now'" ] }, save => [ 1, 5 ], nums => '{1,2,3}', fk1 => 2, last_modified => { le => 'now' }, date_created => '2004-03-30 12:34:56' ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() 2 - $db_type"); my $o2 = $o->clone; $o2->db($db); $o2->id(2); $o2->name('Fred'); ok($o2->save, "object save() 2 - $db_type"); my $o3 = $o2->clone; $o3->db($db); $o3->id(3); $o3->name('Sue'); ok($o3->save, "object save() 3 - $db_type"); my $o4 = $o3->clone; $o4->db($db); $o4->id(4); $o4->name('Bob'); ok($o4->save, "object save() 4 - $db_type"); eval { $objs = MyPgObjectManager->get_objectz( where => [ date_created => '205-1-2', # invalid date ]); }; ok($@, "Invalid date - $db_type"); eval { $objs = MyPgObjectManager->get_objectz( query => [ flag => [] ]); }; ok($@, "Empty list 1 - $db_type"); $objs = MyPgObjectManager->get_objectz( allow_empty_lists => 1, query => [ flag => [] ]); is(scalar @$objs, 4, "Empty list 2 - $db_type"); eval { $objs = MyPgObjectManager->get_objectz( query => [ or => [ flag => 1, nums => { all_in_array => [] } ] ]); }; ok($@, "Empty list 3 - $db_type"); $objs = MyPgObjectManager->get_objectz( allow_empty_lists => 1, query => [ or => [ flag => 1, nums => { all_in_array => [] } ] ]); is(scalar @$objs, 4, "Empty list 4 - $db_type"); $objs = MyPgObjectManager->get_objectz( db => $db, share_db => 1, query_is_sql => 1, query => [ id => { ge => 2 }, name => { like => '%e%' }, flag => 't', flag2 => 'f', status => 'active', bits => '00001', start => '2001-01-02', save => [ 1, 5 ], nums => '{1,2,3}', nums => { all_in_array => [ 1, 3 ] }, '!nums' => { all_in_array => [ 1, 5, 9 ] }, #'!nums' => { all_in_set => [ 1, 5, 9 ] }, nums => { in_array => [ 2, 17 ] }, '!nums' => { in_array => 99 }, last_modified => { le => 'now' }, date_created => '2004-03-30 12:34:56', status => { like => 'AC%', field => 'UPPER(status)' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'name DESC'); is(ref $objs, 'ARRAY', "get_objects() 3 - $db_type"); $objs ||= []; is(scalar @$objs, 2, "get_objects() 4 - $db_type"); is($objs->[0]->id, 3, "get_objects() 5 - $db_type"); is($objs->[1]->id, 2, "get_objects() 6 - $db_type"); my $count = MyPgObjectManager->object_count( share_db => 1, query_is_sql => 1, query => [ id => { ge => 2 }, name => { like => '%e%' }, flag => 't', flag2 => 'f', status => 'active', bits => '00001', start => '2001-01-02', save => [ 1, 5 ], nums => '{1,2,3}', last_modified => { le => 'now' }, date_created => '2004-03-30 12:34:56', status => { like => 'AC%', field => 'UPPER(status)' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'name DESC'); is($count, 2, "get_objects_count() 1 - $db_type"); # Set up sub-object for this one test my $b1 = MyPgBB->new(id => 1, name => 'one', db => $db); $b1->save; $objs->[0]->b1(1); $objs->[0]->save; $count = MyPgObjectManager->object_count( share_db => 1, query_is_sql => 1, require_objects => [ 'bb1' ], query => [ 't2.name' => { like => 'o%' }, 't2_name' => { like => 'on%' }, 'bb1.name' => { like => '%n%' }, id => { ge => 2 }, name => { like => '%e%' }, flag => 't', flag2 => 'f', status => 'active', bits => '00001', start => '2001-01-02', save => [ 1, 5 ], nums => '{1,2,3}', last_modified => { le => 'now' }, date_created => '2004-03-30 12:34:56', status => { like => 'AC%', field => 'UPPER(status)' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'name DESC'); is($count, 1, "get_objects_count() require 1 - $db_type"); # Clear sub-object $objs->[0]->b1(undef); $objs->[0]->save; $b1->delete; my $iterator = MyPgObjectManager->get_objectz_iterator( db => $db, share_db => 1, query_is_sql => 1, query => [ id => { ge => 2 }, name => { like => '%e%' }, flag => 't', flag2 => 'f', status => 'active', bits => '00001', start => '2001-01-02', save => [ 1, 5 ], nums => '{1,2,3}', last_modified => { le => 'now' }, date_created => '2004-03-30 12:34:56', status => { like => 'AC%', field => 'UPPER(status)' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'name'); is(ref $iterator, 'Rose::DB::Object::Iterator', "get_objects_iterator() 1 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "iterator next() 1 - $db_type"); is($o->id, 2, "iterator next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Sue', "iterator next() 3 - $db_type"); is($o->id, 3, "iterator next() 4 - $db_type"); $o = $iterator->next; is($o, 0, "iterator next() 5 - $db_type"); is($iterator->total, 2, "iterator total() - $db_type"); my $fo = MyPgOtherObject->new(name => 'Foo 1', k1 => 1, k2 => 2, k3 => 3, db => $db); ok($fo->save, "object save() 5 - $db_type"); $fo = MyPgOtherObject->new(name => 'Foo 2', k1 => 2, k2 => 3, k3 => 4, db => $db); ok($fo->save, "object save() 6 - $db_type"); $fo = MyPgBB->new(id => 1, name => 'one', db => $db); ok($fo->save, "bb object save() 1 - $db_type"); $fo = MyPgBB->new(id => 2, name => 'two', db => $db); ok($fo->save, "bb object save() 2 - $db_type"); $fo = MyPgBB->new(id => 3, name => 'three', db => $db); ok($fo->save, "bb object save() 3 - $db_type"); $fo = MyPgBB->new(id => 4, name => 'four', db => $db); ok($fo->save, "bb object save() 4 - $db_type"); my $o5 = MyPgObject->new(db => $db, id => 5, name => 'Betty', flag => 'f', flag2 => 't', status => 'with', bits => '10101', start => '2002-05-20', save_col => 123, nums => [ 4, 5, 6 ], data => "\000\001\002", fkone => 1, fk2 => 2, fk3 => 3, b1 => 2, b2 => 4, last_modified => '2001-01-10 20:34:56', date_created => '2002-05-10 10:34:56'); ok($o5->save, "object save() 7 - $db_type"); my $fo1 = $o5->other_obj; ok($fo1 && ref $fo1 && $fo1->k1 == 1 && $fo1->k2 == 2 && $fo1->k3 == 3, "foreign object 1 - $db_type"); $fo1 = $o5->bb1; ok($fo1 && ref $fo1 && $fo1->id == 2, "bb foreign object 1 - $db_type"); $fo1 = $o5->bb2; ok($fo1 && ref $fo1 && $fo1->id == 4, "bb foreign object 2 - $db_type"); $objs = MyPgObjectManager->get_objectz( db => $db, share_db => 1, query_is_sql => 1, query => [ 't1.id' => { ge => 2 }, 't1.name' => { like => '%tt%' }, ], require_objects => [ 'other_obj', 'bb1', 'bb2' ]); ok(ref $objs->[0]->{'other_obj'} eq 'MyPgOtherObject', "foreign object 2 - $db_type"); is($objs->[0]->other_obj->k2, 2, "foreign object 3 - $db_type"); is($objs->[0]->bb1->name, 'two', "bb foreign object 3 - $db_type"); is($objs->[0]->bb2->name, 'four', "bb foreign object 4 - $db_type"); $iterator = MyPgObjectManager->get_objectz_iterator( db => $db, share_db => 1, query_is_sql => 1, query => [ 't1.id' => { ge => 2 }, 't1.name' => { like => '%tt%' }, ], require_objects => [ 'other_obj', 'bb1', 'bb2' ]); $o = $iterator->next; ok(ref $o->{'other_obj'} eq 'MyPgOtherObject', "foreign object 4 - $db_type"); is($o->other_obj->k2, 2, "foreign object 5 - $db_type"); is($o->bb1->name, 'two', "bb foreign object 5 - $db_type"); is($o->bb2->name, 'four', "bb foreign object 6 - $db_type"); # Start "one to many" tests ok($fo = MyPgNick->new(id => 1, o_id => 5, nick => 'none', type => { name => 'nt one', t2 => { name => 'nt2 one' } }, alts => [ { alt => 'alt one 1' }, { alt => 'alt one 2' }, { alt => 'alt one 3' }, ], opts => [ { opt => 'opt one 1' }, { opt => 'opt one 2' } ])->save, "nick object save() 1 - $db_type"); $fo = MyPgNick->new(id => 2, db => $db, o_id => 2, nick => 'ntwo', type => { name => 'nt two', t2 => { name => 'nt2 two' } }, alts => [ { alt => 'alt two 1' } ]); ok($fo->save, "nick object save() 2 - $db_type"); $fo = MyPgNick->new(id => 3, db => $db, o_id => 5, nick => 'nthree', type => { name => 'nt three', t2 => { name => 'nt2 three' } }, opts => [ { opt => 'opt three 1' }, { opt => 'opt three 2' } ]); ok($fo->save, "nick object save() 3 - $db_type"); $fo = MyPgNick->new(id => 4, db => $db, o_id => 2, nick => 'nfour', type => { name => 'nt four', t2 => { name => 'nt2 four' } }); ok($fo->save, "nick object save() 4 - $db_type"); $fo = MyPgNick->new(id => 5, db => $db, o_id => 5, nick => 'nfive', type => { name => 'nt five', t2 => { name => 'nt2 five' } }); ok($fo->save, "nick object save() 5 - $db_type"); $fo = MyPgNick->new(id => 6, db => $db, o_id => 5, nick => 'nsix', type => { name => 'nt six', t2 => { name => 'nt2 six' } }); ok($fo->save, "nick object save() 6 - $db_type"); # # ok($fo = MyPgNick->new(id => 1, # o_id => 5, # db => $db, # nick => 'none')->save, # "nick object save() 1 - $db_type"); # # $fo = MyPgNick->new(id => 2, # o_id => 2, # db => $db, # nick => 'ntwo'); # ok($fo->save, "nick object save() 2 - $db_type"); # # $fo = MyPgNick->new(id => 3, # o_id => 5, # db => $db, # nick => 'nthree'); # ok($fo->save, "nick object save() 3 - $db_type"); # # $fo = MyPgNick->new(id => 4, # o_id => 2, # db => $db, # nick => 'nfour'); # ok($fo->save, "nick object save() 4 - $db_type"); # # $fo = MyPgNick->new(id => 5, # o_id => 5, # db => $db, # nick => 'nfive'); # ok($fo->save, "nick object save() 5 - $db_type"); # # $fo = MyPgNick->new(id => 6, # o_id => 5, # db => $db, # nick => 'nsix'); # ok($fo->save, "nick object save() 6 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; $db->begin_work; $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', share_db => 1, with_objects => [ 'nicks.type' ], for_update => 1, lock => { on => [ qw(nicks rose_db_object_test) ], nowait => 1, }, query => [ 't1.id' => { ge => 1 }, 't1.name' => 'Betty', flag => 'f', flag2 => 1, bits => '10101', 't2.nick' => { like => 'n%' }, data => "\000\001\002", start => '5/20/2002', '!start' => { gt => DateTime->new(year => '2005', month => 12, day => 1) }, '!rose_db_object_test.start' => { gt => DateTime->new(year => '2005', month => 12, day => 2) }, '!t1.start' => { gt => DateTime->new(year => '2005', month => 12, day => 3) }, or => [], and => [], save_col => [ 1, 5, 123 ], nums => [ 4, 5, 6 ], fk1 => 1, last_modified => { le => '6/6/2020' }, # XXX: breaks in 2020! date_created => '5/10/2002 10:34:56 am' ], clauses => [ "LOWER(status) LIKE 'w%'" ], sort_by => 'id'); $db->commit; $db->begin_work; $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', share_db => 1, with_objects => [ 'nicks.type' ], lock => { type => 'shared', tables => [ \q(t2), 'rose_db_object_test' ], nowait => 1, }, query => [ 't1.id' => { ge => 1 }, 't1.name' => 'Betty', flag => 'f', flag2 => 1, bits => '10101', 't2.nick' => { like => 'n%' }, data => "\000\001\002", start => '5/20/2002', '!start' => { gt => DateTime->new(year => '2005', month => 12, day => 1) }, '!rose_db_object_test.start' => { gt => DateTime->new(year => '2005', month => 12, day => 2) }, '!t1.start' => { gt => DateTime->new(year => '2005', month => 12, day => 3) }, or => [], and => [], save_col => [ 1, 5, 123 ], nums => [ 4, 5, 6 ], fk1 => 1, last_modified => { le => '6/6/2020' }, # XXX: breaks in 2020! date_created => '5/10/2002 10:34:56 am' ], clauses => [ "LOWER(status) LIKE 'w%'" ], sort_by => 'id'); $db->commit; $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', share_db => 1, with_objects => [ 'nicks.type' ], query => [ 't1.id' => { ge => 1 }, 't1.name' => 'Betty', flag => 'f', flag2 => 1, bits => '10101', 't2.nick' => { like => 'n%' }, data => "\000\001\002", start => '5/20/2002', '!start' => { gt => DateTime->new(year => '2005', month => 12, day => 1) }, '!rose_db_object_test.start' => { gt => DateTime->new(year => '2005', month => 12, day => 2) }, '!t1.start' => { gt => DateTime->new(year => '2005', month => 12, day => 3) }, or => [], and => [], save_col => [ 1, 5, 123 ], nums => [ 4, 5, 6 ], fk1 => 1, last_modified => { le => '6/6/2020' }, # XXX: breaks in 2020! date_created => '5/10/2002 10:34:56 am' ], clauses => [ "LOWER(status) LIKE 'w%'" ], sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() with many 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() with many 2 - $db_type"); ok(!defined $objs->[0]->{'status'}, "lazy main 1 - $db_type"); is($objs->[0]->status, 'with', "lazy main 2 - $db_type"); my $object = MyPgObject->new(db => $db, id => $objs->[0]->id); $object->load(with => [ 'nicks.type' ]); is($object->{'status'}, undef, "lazy load(with) 1 - $db_type"); my $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many 3 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many 4 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many 5 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many 6 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many 7 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', share_db => 1, with_objects => [ 'bb2', 'nicks', 'bb1' ], query => [ 't1.id' => { ge => 1 }, 't1.name' => 'Betty', flag => 'f', flag2 => 1, bits => '10101', 't3.nick' => { like => 'n%' }, data => "\000\001\002", start => '5/20/2002', '!start' => { gt => DateTime->new(year => '2005', month => 12, day => 1) }, '!rose_db_object_test.start' => { gt => DateTime->new(year => '2005', month => 12, day => 2) }, '!t1.start' => { gt => DateTime->new(year => '2005', month => 12, day => 3) }, save_col => [ 1, 5, 123 ], nums => [ 4, 5, 6 ], fk1 => 1, last_modified => { le => '6/6/2020' }, # XXX: breaks in 2020! date_created => '5/10/2002 10:34:56 am' ], clauses => [ "LOWER(status) LIKE 'w%'" ], sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() with many 8 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() with many 9 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many 10 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many 11 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many 12 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many 13 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many 14 - $db_type"); $fo1 = $objs->[0]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects() with many bb1 1 - $db_type"); $fo1 = $objs->[0]->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects() with many bb2 2 - $db_type"); $iterator = MyPgObjectManager->get_objectz_iterator( db => $db, share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => [ 'nicks' ], sort_by => 't1.name'); is(ref $iterator, 'Rose::DB::Object::Iterator', "get_objects_iterator() 1 - $db_type"); $o = $iterator->next; is($o->name, 'Betty', "iterator many next() 1 - $db_type"); is($o->id, 5, "iterator many next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Bob', "iterator many next() 3 - $db_type"); is($o->id, 4, "iterator many next() 4 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "iterator many next() 5 - $db_type"); is($o->id, 2, "iterator many next() 6 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "iterator many sub-object 1 - $db_type"); is($o->{'nicks'}[0]{'nick'}, 'ntwo', "iterator many sub-object 2 - $db_type"); is($o->{'nicks'}[1]{'nick'}, 'nfour', "iterator many sub-object 3 - $db_type"); $o = $iterator->next; is($o->name, 'Sue', "iterator many next() 7 - $db_type"); is($o->id, 3, "iterator many next() 8 - $db_type"); $o = $iterator->next; is($o, 0, "iterator many next() 9 - $db_type"); is($iterator->total, 4, "iterator many total() - $db_type"); $iterator = MyPgObjectManager->get_objectz_iterator( db => $db, share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], sort_by => 't1.name', limit => 2); $o = $iterator->next; is($o->name, 'Betty', "iterator limit 2 many next() 1 - $db_type"); is($o->id, 5, "iterator limit 2 many next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Bob', "iterator limit 2 many next() 3 - $db_type"); is($o->id, 4, "iterator limit 2 many next() 4 - $db_type"); $o = $iterator->next; is($o, 0, "iterator limit 2 many next() 5 - $db_type"); is($iterator->total, 2, "iterator limit 2 many total() - $db_type"); $iterator = MyPgObjectManager->get_objectz_iterator( db => $db, share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => 1, sort_by => 't1.name', limit => 3); $o = $iterator->next; is($o->name, 'Betty', "iterator limit 3 many next() 1 - $db_type"); is($o->id, 5, "iterator limit 3 many next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Bob', "iterator limit 3 many next() 3 - $db_type"); is($o->id, 4, "iterator limit 3 many next() 4 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "iterator limit 3 many next() 5 - $db_type"); is($o->id, 2, "iterator limit 3 many next() 6 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "iterator limit 3 many sub-object 1 - $db_type"); is($o->{'nicks'}[0]{'nick'}, 'ntwo', "iterator limit 3 many sub-object 2 - $db_type"); is($o->{'nicks'}[1]{'nick'}, 'nfour', "iterator limit 3 many sub-object 3 - $db_type"); $o = $iterator->next; is($o, 0, "iterator limit 3 many next() 7 - $db_type"); is($iterator->total, 3, "iterator limit 3 many total() - $db_type"); $objs = MyPgObjectManager->get_objectz( db => $db, share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], sort_by => 't1.name', limit => 2); ok(ref $objs && @$objs == 2, "get_objects() limit 2 many 1 - $db_type"); is($objs->[0]->name, 'Betty', "get_objects() limit 2 many 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() limit 2 many 3 - $db_type"); is($objs->[1]->name, 'Bob', "get_objects() limit 2 many 4 - $db_type"); is($objs->[1]->id, 4, "get_objects() limit 2 many 5 - $db_type"); $objs = MyPgObjectManager->get_objectz( db => $db, share_db => 1, with_objects => [ 'nicks', 'bb2' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => 1, sort_by => 't1.name', limit => 3); ok(ref $objs && @$objs == 3, "get_objects() limit 3 many 1 - $db_type"); is($objs->[0]->name, 'Betty', "get_objects() limit 3 many 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() limit 3 many 3 - $db_type"); is($objs->[1]->name, 'Bob', "get_objects() limit 3 many 4 - $db_type"); is($objs->[1]->id, 4, "get_objects() limit 3 many 5 - $db_type"); is($objs->[2]->name, 'Fred', "get_objects() limit 3 many 6 - $db_type"); is($objs->[2]->id, 2, "get_objects() limit 3 many 7 - $db_type"); is(scalar @{$objs->[2]->{'nicks'}}, 2, 'get_objects() limit 3 many sub-object 1'); is($objs->[2]->{'nicks'}[0]{'nick'}, 'ntwo', 'get_objects() limit 3 many sub-object 2'); is($objs->[2]->{'nicks'}[1]{'nick'}, 'nfour', 'get_objects() limit 3 many sub-object 3'); $iterator = MyPgObjectManager->get_objectz_iterator( db => $db, share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => 1, sort_by => 't1.name', limit => 2, offset => 1); $o = $iterator->next; is($o->name, 'Bob', "iterator limit 2 offset 1 many next() 1 - $db_type"); is($o->id, 4, "iterator limit 2 offset 1 many next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "iterator limit 2 offset 1 many next() 3 - $db_type"); is($o->id, 2, "iterator limit 2 offset 1 many next() 4 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, 'iterator limit 2 offset 1 many sub-object 1'); is($o->{'nicks'}[0]{'nick'}, 'ntwo', 'iterator limit 2 offset 1 many sub-object 2'); is($o->{'nicks'}[1]{'nick'}, 'nfour', 'iterator limit 2 offset 1 many sub-object 3'); $o = $iterator->next; is($o, 0, "iterator limit 2 offset 1 many next() 5 - $db_type"); is($iterator->total, 2, "iterator limit 2 offset 1 many total() - $db_type"); $iterator = MyPgObjectManager->get_objectz_iterator( db => $db, share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => 1, sort_by => 't1.name', limit => 3, offset => 2); $o = $iterator->next; is($o->name, 'Fred', "iterator limit 3 offset 2 many next() 1 - $db_type"); is($o->id, 2, "iterator limit 3 offset 2 many next() 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, 'iterator limit 3 offset 2 many sub-object 1'); is($o->{'nicks'}[0]{'nick'}, 'ntwo', 'iterator limit 3 offset 2 many sub-object 2'); is($o->{'nicks'}[1]{'nick'}, 'nfour', 'iterator limit 3 offset 2 many sub-object 3'); $o = $iterator->next; is($o->name, 'Sue', "iterator limit 3 offset 2 many next() 3 - $db_type"); is($o->id, 3, "iterator limit 3 offset 2 many next() 4 - $db_type"); $o = $iterator->next; is($o, 0, "iterator limit 3 offset 2 many next() 5 - $db_type"); is($iterator->total, 2, "iterator limit 3 offset 2 many total() - $db_type"); $objs = MyPgObjectManager->get_objectz( db => $db, share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => 1, sort_by => 't1.name', limit => 2, offset => 1); ok(ref $objs && @$objs == 2, "get_objects() limit 2 offset 1 many 1 - $db_type"); is($objs->[0]->name, 'Bob', "get_objects() limit 2 offset 1 many 2 - $db_type"); is($objs->[0]->id, 4, "get_objects() limit 2 offset 1 many 3 - $db_type"); is($objs->[1]->name, 'Fred', "get_objects() limit 2 offset 1 many 4 - $db_type"); is($objs->[1]->id, 2, "get_objects() limit 2 offset 1 many 5 - $db_type"); is(scalar @{$objs->[1]->{'nicks'}}, 2, 'get_objects() limit 2 offset 1 many sub-object 1'); is($objs->[1]->{'nicks'}[0]{'nick'}, 'ntwo', 'get_objects() limit 2 offset 1 many sub-object 2'); is($objs->[1]->{'nicks'}[1]{'nick'}, 'nfour', 'get_objects() limit 2 offset 1 many sub-object 3'); $objs = MyPgObjectManager->get_objectz( db => $db, share_db => 1, with_objects => [ 'nicks', 'bb2' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => 1, sort_by => 't1.name', limit => 3, offset => 2); ok(ref $objs && @$objs == 2, "get_objects() limit 3 offset 2 many 1 - $db_type"); is($objs->[0]->name, 'Fred', "get_objects() limit 3 offset 2 many 2 - $db_type"); is($objs->[0]->id, 2, "get_objects() limit 3 offset 2 many 3 - $db_type"); is(scalar @{$objs->[0]->{'nicks'}}, 2, 'get_objects() limit 3 offset 2 many sub-object 1'); is($objs->[0]->{'nicks'}[0]{'nick'}, 'ntwo', 'get_objects() limit 3 offset 2 many sub-object 2'); is($objs->[0]->{'nicks'}[1]{'nick'}, 'nfour', 'get_objects() limit 3 offset 2 many sub-object 3'); is($objs->[1]->name, 'Sue', "get_objects() limit 3 offset 2 many 4 - $db_type"); is($objs->[1]->id, 3, "get_objects() limit 3 offset 2 many 5 - $db_type"); my $o6 = $o2->clone; $o6->db($db); $o6->id(60); $o6->fkone(undef); $o6->fk2(undef); $o6->fk3(undef); $o6->b1(undef); $o6->b2(2); $o6->name('Ted'); ok($o6->save, "object save() 8 - $db_type"); my $o7 = $o2->clone; $o7->db($db); $o7->id(70); $o7->b1(3); $o7->b2(undef); $o7->name('Joe'); ok($o7->save, "object save() 9 - $db_type"); my $o8 = $o2->clone; $o8->db($db); $o8->id(80); $o8->b1(undef); $o8->b2(undef); $o8->name('Pete'); ok($o8->save, "object save() 10 - $db_type"); $fo = MyPgNick->new(id => 7, o_id => 60, db => $db, nick => 'nseven'); ok($fo->save, "nick object save() 7 - $db_type"); $fo = MyPgNick->new(id => 8, o_id => 60, db => $db, nick => 'neight'); ok($fo->save, "nick object save() 8 - $db_type"); $fo = MyPgNick->new(id => 9, o_id => 60, db => $db, nick => 'neight'); ok($fo->save, "nick object save() 8 - $db_type"); $fo = MyPgNick2->new(id => 1, o_id => 5, db => $db, nick2 => 'n2one'); ok($fo->save, "nick2 object save() 1 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', share_db => 1, require_objects => [ 'bb2', 'bb1' ], query => [ '!t1.id' => 5 ], sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() with many 15 - $db_type"); $objs ||= []; is(scalar @$objs, 0, "get_objects() with many 16 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( db => $db, object_class => 'MyPgObject', share_db => 1, require_objects => [ 'bb2', 'bb1' ], with_objects => [ 'nicks' ], query => [ ], sort_by => 't1.id'); is($count, 1, "get_objects_count() require 1 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; $count = Rose::DB::Object::Manager->get_objects_count( db => $db, object_class => 'MyPgObject', share_db => 1, require_objects => [ 'bb2' ], with_objects => [ 'nicks' ], query => [ ], sort_by => 't1.id'); is($count, 2, "get_objects_count() require 2 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', share_db => 1, require_objects => [ 'bb2', 'bb1' ], with_objects => [ 'nicks' ], query => [ ], sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() with many 17 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() with many 18 - $db_type"); is($objs->[0]->id, 5, "get_objects() with many 19 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many 20 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many 21 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many 22 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many 23 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many 24 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', share_db => 1, require_objects => [ 'bb1', 'bb2' ], with_objects => [ 'nicks2', 'nicks' ], multi_many_ok => 1, query => [ ], sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() with multi many 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() with multi many 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() with multi many 3 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with multi many 4 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with multi many 5 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with multi many 6 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with multi many 7 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with multi many 8 - $db_type"); is($objs->[0]->{'nicks2'}[0]{'nick2'}, 'n2one', "get_objects() with multi many 9 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( db => $db, object_class => 'MyPgObject', share_db => 1, require_objects => [ 'bb1', 'bb2' ], with_objects => [ 'nicks2', 'nicks' ], multi_many_ok => 1, query => [ ], sort_by => 't1.id'); $o = $iterator->next; is($o->name, 'Betty', "iterator with and require 1 - $db_type"); is($o->id, 5, "iterator with and require 2 - $db_type"); $nicks = $o->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "iterator with and require 3 - $db_type"); is($nicks->[0]->nick, 'nthree', "iterator with and require 4 - $db_type"); is($nicks->[1]->nick, 'nsix', "iterator with and require 5 - $db_type"); is($nicks->[2]->nick, 'none', "iterator with and require 6 - $db_type"); is($nicks->[3]->nick, 'nfive', "iterator with and require 7 - $db_type"); is($o->{'nicks2'}[0]{'nick2'}, 'n2one', "iterator with and require 8 - $db_type"); $o = $iterator->next; is($o, 0, "iterator with and require 9 - $db_type"); is($iterator->total, 1, "iterator with and require 10 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', share_db => 1, with_objects => [ 'bb2', 'nicks', 'bb1' ], query => [ ], sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() with many 25 - $db_type"); $objs ||= []; is(scalar @$objs, 8, "get_objects() with many 26 - $db_type"); my $ids = join(',', map { $_->id } @$objs); is($ids, '1,2,3,4,5,60,70,80', "get_objects() with many 27 - $db_type"); $nicks = $objs->[4]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many 28 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many 29 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many 30 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many 31 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many 32 - $db_type"); is($objs->[6]->{'bb1'}->{'name'}, 'three', "get_objects() with many 33 - $db_type"); ok(!defined $objs->[6]->{'bb2'}, "get_objects() with many 34 - $db_type"); ok(!defined $objs->[6]->{'nicks'}, "get_objects() with many 35 - $db_type"); ok(!defined $objs->[7]->{'bb1'}, "get_objects() with many 36 - $db_type"); ok(!defined $objs->[7]->{'bb1'}, "get_objects() with many 37 - $db_type"); ok(!defined $objs->[7]->{'nicks'}, "get_objects() with many 38 - $db_type"); $fo = MyPgNick->new(id => 7); ok($fo->delete, "with many clean-up 1 - $db_type"); $fo = MyPgNick->new(id => 8); ok($fo->delete, "with many clean-up 2 - $db_type"); $fo = MyPgNick->new(id => 9); ok($fo->delete, "with many clean-up 3 - $db_type"); ok($o6->delete, "with many clean-up 4 - $db_type"); ok($o7->delete, "with many clean-up 5 - $db_type"); ok($o8->delete, "with many clean-up 6 - $db_type"); $fo = MyPgNick2->new(id => 1); ok($fo->delete, "with many clean-up 7 - $db_type"); # End "one to many" tests $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', share_db => 1, #debug => 1, query => [ id => { ge => 1 }, name => 'John', flag => 1, flag2 => 0, \q((1 = 1 and 5 > 2)), [ \q(fk1 > ?), 1 ], or => [ bits => '00001', \q((2 = 2 and 6 > 3)), fk1 => { gt => 1 }, and => [ status => 'active', [ \q(7 > ?), 3 ], ], ], status => 'active', bits => '1', start => '1/2/2001', data => "\000\001\002", '!start' => { gt => DateTime->new(year => '2005', month => 1, day => 1) }, '!rose_db_object_test.start' => { gt => DateTime->new(year => '2005', month => 2, day => 2) }, '!t1.start' => { gt => DateTime->new(year => '2005', month => 3, day => 3) }, save_col => [ 1, 5 ], nums => [ 1, 2, 3 ], fk1 => 2, last_modified => { le => '6/6/2020' }, # XXX: breaks in 2020! date_created => '3/30/2004 12:34:56 pm' ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() 7 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() 8 - $db_type"); $objs = MyPgObjectManager->get_objectz( db => $db, share_db => 1, query => [ id => { ge => 2 }, k1 => { lt => 900 }, or => [ k1 => { ne => 99 }, k1 => 100 ], or => [ and => [ id => { ne => 123 }, id => { lt => 100 } ], and => [ id => { ne => 456 }, id => { lt => 300 } ] ], '!k2' => { gt => 999 }, '!t2.name' => 'z', start => { lt => DateTime->new(year => '2005', month => 1, day => 1) }, '!start' => { gt => DateTime->new(year => '2005', month => 1, day => 1) }, 'rose_db_object_test.name' => { like => '%tt%' }, '!rose_db_object_other.name' => 'q', '!rose_db_object_other.name' => [ 'x', 'y' ], ], require_objects => [ 'other_obj' ]); ok(ref $objs->[0]->{'other_obj'} eq 'MyPgOtherObject', "foreign object 6 - $db_type"); is($objs->[0]->other_obj->k2, 2, "foreign object 7 - $db_type"); # Test limit with offset foreach my $id (6 .. 20) { my $o = $o5->clone; $o->db($db); $o->id($id); $o->name("Clone $id"); ok($o->save, "object save() clone $id - $db_type"); } $objs = MyPgObjectManager->get_objectz( db => $db, object_class => 'MyPgObject', sort_by => 'id DESC', limit => 2, offset => 8); ok(ref $objs eq 'ARRAY' && @$objs == 2 && $objs->[0]->id == 12 && $objs->[1]->id == 11, "get_objects() with offset - $db_type"); $objs = MyPgObjectManager->get_objectz( db => $db, object_class => 'MyPgObject', sort_by => 'id DESC', require_objects => [ 'other_obj' ], limit => 2, offset => 8); ok(ref $objs eq 'ARRAY' && @$objs == 2 && $objs->[0]->id == 12 && $objs->[1]->id == 11, "get_objects() with objects and offset - $db_type"); $iterator = MyPgObjectManager->get_objectz_iterator( db => $db, object_class => 'MyPgObject', sort_by => 'id DESC', limit => 2, offset => 8); $o = $iterator->next; is($o->id, 12, "get_objects_iterator() with offset 1 - $db_type"); $o = $iterator->next; is($o->id, 11, "get_objects_iterator() with offset 2 - $db_type"); is($iterator->next, 0, "get_objects_iterator() with offset 3 - $db_type"); eval { $objs = MyPgObjectManager->get_objectz( object_class => 'MyPgObject', sort_by => 'id DESC', offset => 8) }; ok($@ =~ /invalid without a limit/, "get_objects() missing offset - $db_type"); eval { $iterator = MyPgObjectManager->get_objectz_iterator( db => $db, object_class => 'MyPgObject', sort_by => 'id DESC', offset => 8); }; ok($@ =~ /invalid without a limit/, "get_objects_iterator() missing offset - $db_type"); # Start *_sql comparison tests $o6->fk2(99); $o6->fk3(99); $o6->save; $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', query => [ 'fk2' => { eq_sql => 'fk3' } ], sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq_sql 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() eq_sql 2 - $db_type"); is($objs->[0]->id, 60, "get_objects() eq_sql 3 - $db_type"); # End *_sql comparison tests # Start IN NULL tests #local $Rose::DB::Object::Manager::Debug = 1; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyPgObject', query => [ id => [ undef, 60 ], '!id' => \'id + 1' ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() in null 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() in null 2 - $db_type"); is($objs->[0]->id, 60, "get_objects() in null 3 - $db_type"); # End IN NULL tests # Start scalar ref tests #local $Rose::DB::Object::Manager::Debug = 1; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyPgObject', query => [ 'fk2' => \'fk3' ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq ref 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() eq ref 2 - $db_type"); is($objs->[0]->id, 60, "get_objects() eq ref 3 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyPgObject', query => [ 'fk2' => [ \'fk3' ] ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq ref 4 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() eq ref 5 - $db_type"); is($objs->[0]->id, 60, "get_objects() eq ref 6 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyPgObject', query => [ 'fk2' => { ne => \'fk3' } ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq ref 7 - $db_type"); $objs ||= []; is(scalar @$objs, 16, "get_objects() eq ref 8 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyPgObject', query => [ 'fk2' => { ne => [ \'fk3' ] } ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq ref 9 - $db_type"); $objs ||= []; is(scalar @$objs, 16, "get_objects() eq ref 10 - $db_type"); # End scalar ref tests # Start "many to many" tests $fo = MyPgColor->new(id => 1, name => 'Red', db => $db); $fo->save; $fo = MyPgColor->new(id => 2, name => 'Green', db => $db); $fo->save; $fo = MyPgColor->new(id => 3, name => 'Blue', db => $db); $fo->save; $fo = MyPgColorMap->new(id => 1, object_id => $o2->id, color_id => 1, db => $db); $fo->save; $fo = MyPgColorMap->new(id => 2, object_id => $o2->id, color_id => 3, db => $db); $fo->save; $o2->b1(4); $o2->b1(2); $o2->fkone(2); $o2->fk2(3); $o2->fk3(4); $o2->save; my @colors = $o2->colors; ok(@colors == 2 && $colors[0]->name eq 'Red' && $colors[1]->name eq 'Blue', "Fetch many to many 1 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', share_db => 1, with_objects => [ 'other_obj', 'bb2', 'nicks', 'bb1', 'colors' ], multi_many_ok => 1, with_map_records => 'map_record', query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); is(ref $objs, 'ARRAY', "get_objects() with many to many 1 - $db_type"); $objs ||= []; is(scalar @$objs, 3, "get_objects() with many to many 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() with many to many 3 - $db_type"); is($objs->[1]->id, 2, "get_objects() with many to many 4 - $db_type"); is($objs->[2]->id, 1, "get_objects() with many to many 5 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many to many 6 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many to many 7 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many to many 8 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many to many 9 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many to many 10 - $db_type"); $fo1 = $objs->[0]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects() with many to many 11 - $db_type"); $fo1 = $objs->[0]->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects() with many to many 12 - $db_type"); my $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() with many to many 13 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() with many to many 14 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects() with many to many 15 - $db_type"); is($colors->[0]->map_record->color_id, $colors->[0]->id, "map_record 1 - $db_type"); is($colors->[0]->map_record->object_id, $objs->[1]->id, "map_record 2 - $db_type"); is($colors->[1]->map_record->color_id, $colors->[1]->id, "map_record 3 - $db_type"); is($colors->[0]->map_record->object_id, $objs->[1]->id, "map_record 4 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( db => $db, object_class => 'MyPgObject', share_db => 1, with_objects => [ 'other_obj', 'bb2', 'nicks', 'bb1', 'colors' ], multi_many_ok => 1, with_map_records => 'map_record', query => [ id => [ 1, 2, 5 ] ], sort_by => 't1.name'); $objs = []; while(my $obj = $iterator->next) { push(@$objs, $obj); } is(ref $objs, 'ARRAY', "get_objects_iterator() with many to many map record 1 - $db_type"); is(scalar @$objs, 3, "get_objects_iterator() with many to many map record 2 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db is($colors->[0]->map_record->color_id, $colors->[0]->id, "map_record 5 - $db_type"); is($colors->[0]->map_record->object_id, $objs->[1]->id, "map_record 6 - $db_type"); is($colors->[1]->map_record->color_id, $colors->[1]->id, "map_record 7 - $db_type"); is($colors->[0]->map_record->object_id, $objs->[1]->id, "map_record 8 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', share_db => 1, with_objects => [ 'other_obj', 'bb2', 'nicks', 'bb1', 'colors' ], multi_many_ok => 1, with_map_records => 'map_rec', query => [ id => [ 1, 2, 5 ] ], sort_by => 't1.name'); is(ref $objs, 'ARRAY', "get_objects() with many to many 1 - $db_type"); $objs ||= []; is(scalar @$objs, 3, "get_objects() with many to many 2 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db is($colors->[0]->map_rec->color_id, $colors->[0]->id, "map_rec 1 - $db_type"); is($colors->[0]->map_rec->object_id, $objs->[1]->id, "map_rec 2 - $db_type"); is($colors->[1]->map_rec->color_id, $colors->[1]->id, "map_rec 3 - $db_type"); is($colors->[0]->map_rec->object_id, $objs->[1]->id, "map_rec 4 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', share_db => 1, with_objects => [ 'bb1', 'nicks', 'other_obj', 'colors', 'bb2' ], multi_many_ok => 1, query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); is(ref $objs, 'ARRAY', "get_objects() with many to many (reorder) 1 - $db_type"); $objs ||= []; is(scalar @$objs, 3, "get_objects() with many to many (reorder) 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() with many to many (reorder) 3 - $db_type"); is($objs->[1]->id, 2, "get_objects() with many to many (reorder) 4 - $db_type"); is($objs->[2]->id, 1, "get_objects() with many to many (reorder) 5 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many to many (reorder) 6 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many to many (reorder) 7 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many to many (reorder) 8 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many to many (reorder) 9 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many to many (reorder) 10 - $db_type"); $fo1 = $objs->[0]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects() with many to many (reorder) 11 - $db_type"); $fo1 = $objs->[0]->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects() with many to many (reorder) 12 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() with many to many (reorder) 13 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() with many to many (reorder) 14 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects() with many to many (reorder) 15 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', share_db => 1, with_objects => [ 'nicks', 'colors', 'bb2' ], multi_many_ok => 1, require_objects => [ 'bb1', 'other_obj' ], query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); is(ref $objs, 'ARRAY', "get_objects() with many to many require with 1 - $db_type"); $objs ||= []; is(scalar @$objs, 2, "get_objects() with many to many require with 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() with many to many require with 3 - $db_type"); is($objs->[1]->id, 2, "get_objects() with many to many require with 4 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many to many require with 6 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many to many 7 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many to many 8 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many to many 9 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many to many 10 - $db_type"); $fo1 = $objs->[0]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects() with many to many require with 11 - $db_type"); $fo1 = $objs->[0]->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects() with many to many require with 12 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() with many to many require with 13 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() with many to many require with 14 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects() with many to many require with 15 - $db_type"); $fo1 = $objs->[1]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'two', "get_objects() with many to many require with 16 - $db_type"); $fo1 = $objs->[0]->{'other_obj'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'Foo 1', "get_objects() with many to many require with 17 - $db_type"); $fo1 = $objs->[1]->{'other_obj'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'Foo 2', "get_objects() with many to many require with 18 - $db_type"); ok(!defined $objs->[0]->{'colors'}, "get_objects() with many to many require with 19 - $db_type"); ok(!defined $objs->[1]->{'bb2'}, "get_objects() with many to many require with 20 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; $iterator = Rose::DB::Object::Manager->get_objects_iterator( db => $db, object_class => 'MyPgObject', share_db => 1, with_objects => [ 'other_obj', 'bb2', 'nicks', 'bb1', 'colors' ], multi_many_ok => 1, query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); $o = $iterator->next; is($o->name, 'Betty', "get_objects_iterator() with many to many 1 - $db_type"); is($o->id, 5, "get_objects_iterator() with many to many 2 - $db_type"); $nicks = $o->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects_iterator() with many to many 3 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects_iterator() with many to many 4 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects_iterator() with many to many 5 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects_iterator() with many to many 6 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects_iterator() with many to many 7 - $db_type"); $fo1 = $o->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects_iterator() with many to many 8 - $db_type"); $fo1 = $o->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects_iterator() with many to many 9 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "get_objects_iterator() with many to many 10 - $db_type"); is($o->id, 2, "get_objects_iterator() with many to many 11 - $db_type"); $colors = $o->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects_iterator() with many to many 12 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many 13 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many 14 - $db_type"); $o = $iterator->next; is($o->name, 'John', "get_objects_iterator() with many to many 15 - $db_type"); is($o->id, 1, "get_objects_iterator() with many to many 16 - $db_type"); $o = $iterator->next; is($o, 0, "get_objects_iterator() with many to many 17 - $db_type"); is($iterator->total, 3, "get_objects_iterator() with many to many 18 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( db => $db, object_class => 'MyPgObject', share_db => 1, with_objects => [ 'bb1', 'nicks', 'other_obj', 'colors', 'bb2' ], multi_many_ok => 1, query => [ 't1.id' => [ 1, 2, 5 ], data => { ne => "\001" }, data => { ne => \"'0'::bytea" } ], #" sort_by => 't1.name'); $o = $iterator->next; is($o->name, 'Betty', "get_objects_iterator() with many to many 19 - $db_type"); is($o->id, 5, "get_objects_iterator() with many to many 20 - $db_type"); $nicks = $o->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects_iterator() with many to many 21 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects_iterator() with many to many 22 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects_iterator() with many to many 23 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects_iterator() with many to many 24 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects_iterator() with many to many 25 - $db_type"); $fo1 = $o->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects_iterator() with many to many 26 - $db_type"); $fo1 = $o->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects_iterator() with many to many 27 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "get_objects_iterator() with many to many 28 - $db_type"); is($o->id, 2, "get_objects_iterator() with many to many 29 - $db_type"); $colors = $o->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects_iterator() with many to many 30 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many 31 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many 32 - $db_type"); $o = $iterator->next; is($o->name, 'John', "get_objects_iterator() with many to many 33 - $db_type"); is($o->id, 1, "get_objects_iterator() with many to many 34 - $db_type"); $o = $iterator->next; is($o, 0, "get_objects_iterator() with many to many 35 - $db_type"); is($iterator->total, 3, "get_objects_iterator() with many to many 36 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( db => $db, object_class => 'MyPgObject', share_db => 1, with_objects => [ 'nicks', 'colors', 'bb2' ], multi_many_ok => 1, require_objects => [ 'bb1', 'other_obj' ], query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); $o = $iterator->next; is($o->name, 'Betty', "get_objects_iterator() with many to many require 1 - $db_type"); is($o->id, 5, "get_objects_iterator() with many to many require 2 - $db_type"); $fo1 = $o->{'other_obj'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'Foo 1', "get_objects_iterator() with many to many require 3 - $db_type"); ok(!defined $o->{'colors'}, "get_objects_iterator() with many to many require 4 - $db_type"); $nicks = $o->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects_iterator() with many to many require 5 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects_iterator() with many to many require 6 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects_iterator() with many to many require 7 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects_iterator() with many to many require 8 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects_iterator() with many to many require 9 - $db_type"); $fo1 = $o->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects_iterator() with many to many require 10 - $db_type"); $fo1 = $o->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects_iterator() with many to many require 11 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "get_objects_iterator() with many to many require 12 - $db_type"); is($o->id, 2, "get_objects_iterator() with many to many require 13 - $db_type"); $colors = $o->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects_iterator() with many to many require 14 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many require 15 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many require 16 - $db_type"); $fo1 = $o->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'two', "get_objects_iterator() with many to many require 17 - $db_type"); $fo1 = $o->{'other_obj'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'Foo 2', "get_objects_iterator() with many to many require 18 - $db_type"); ok(!defined $o->{'bb2'}, "get_objects_iterator() with many to many require 19 - $db_type"); $o = $iterator->next; is($o, 0, "get_objects_iterator() with many to many require 20 - $db_type"); is($iterator->total, 2, "get_objects_iterator() with many to many require 21 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( db => $db, object_class => 'MyPgObject', share_db => 1, with_objects => [ 'nicks', 'colors', 'bb2' ], multi_many_ok => 1, require_objects => [ 'bb1', 'other_obj' ], query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name', limit => 1, offset => 5); ok(!$iterator->next, "get_objects_iterator() with many to many require 22 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', share_db => 1, with_objects => [ 'nicks', 'colors', 'bb2' ], multi_many_ok => 1, require_objects => [ 'bb1', 'other_obj' ], query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name', limit => 1, offset => 5); ok(@$objs == 0, "get_objects_iterator() with many to many require 23 - $db_type"); # End "many to many" tests # Start multi-require tests $fo = MyPgColorMap->new(id => 3, object_id => 5, color_id => 2, db => $db); $fo->save; $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', share_db => 1, require_objects => [ 'nicks', 'colors', 'other_obj' ], multi_many_ok => 1, sort_by => 't1.name'); is(scalar @$objs, 2, "get_objects() multi many require 1 - $db_type"); is($objs->[0]->id, 5, "get_objects() multi many require 2 - $db_type"); is($objs->[1]->id, 2, "get_objects() multi many require 3 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() multi many require 4 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() multi many require 5 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() multi many require 6 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() multi many require 7 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() multi many require 8 - $db_type"); $colors = $objs->[0]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 1, "get_objects() multi many require 9 - $db_type"); ok($colors->[0]->id == 2 && $colors->[0]->name eq 'Green', "get_objects() multi many require 10 - $db_type"); $nicks = $objs->[1]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 2, "get_objects() multi many require 11 - $db_type"); is($nicks->[0]->nick, 'ntwo', "get_objects() multi many require 12 - $db_type"); is($nicks->[1]->nick, 'nfour', "get_objects() multi many require 13 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() multi many require 14 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() multi many require 15 - $db_type"); ok($colors->[1]->id == 3 && $colors->[1]->name eq 'Blue', "get_objects() multi many require 16 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', share_db => 1, require_objects => [ 'nicks', 'colors', 'other_obj' ], with_objects => [ 'bb2' ], multi_many_ok => 1, sort_by => 't1.name'); is(scalar @$objs, 2, "get_objects() multi many with require 1 - $db_type"); is($objs->[0]->id, 5, "get_objects() multi many with require 2 - $db_type"); is($objs->[1]->id, 2, "get_objects() multi many with require 3 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() multi many with require 4 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() multi many with require 5 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() multi many with require 6 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() multi many with require 7 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() multi many with require 8 - $db_type"); $colors = $objs->[0]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 1, "get_objects() multi many with require 9 - $db_type"); ok($colors->[0]->id == 2 && $colors->[0]->name eq 'Green', "get_objects() multi many with require 10 - $db_type"); $nicks = $objs->[1]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 2, "get_objects() multi many with require 11 - $db_type"); is($nicks->[0]->nick, 'ntwo', "get_objects() multi many with require 12 - $db_type"); is($nicks->[1]->nick, 'nfour', "get_objects() multi many with require 13 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() multi many with require 14 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() multi many with require 15 - $db_type"); ok($colors->[1]->id == 3 && $colors->[1]->name eq 'Blue', "get_objects() multi many with require 16 - $db_type"); is($objs->[0]->{'bb2'}{'name'}, 'four', "get_objects() multi many with require 17 - $db_type"); ok(!defined $objs->[1]->{'bb2'}{'name'}, "get_objects() multi many with require 18 - $db_type"); MyPgNick->new(id => 7, o_id => 10, nick => 'nseven', db => $db)->save; MyPgNick->new(id => 8, o_id => 11, nick => 'neight', db => $db)->save; MyPgNick->new(id => 9, o_id => 12, nick => 'nnine', db => $db)->save; $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', share_db => 1, require_objects => [ 'nicks', 'bb1' ], with_objects => [ 'colors' ], multi_many_ok => 1, sort_by => 't1.name'); is(scalar @$objs, 5, "get_objects() multi many with require map 1 - $db_type"); is($objs->[0]->id, 5, "get_objects() multi many with require map 2 - $db_type"); is($objs->[1]->id, 10, "get_objects() multi many with require map 3 - $db_type"); is($objs->[2]->id, 11, "get_objects() multi many with require map 4 - $db_type"); is($objs->[3]->id, 12, "get_objects() multi many with require map 5 - $db_type"); is($objs->[4]->id, 2, "get_objects() multi many with require map 6 - $db_type"); # End multi-require tests # Start distinct tests my $i = 0; foreach my $distinct (1, [ 't1' ], [ 'rose_db_object_test' ]) { $i++; $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', distinct => $distinct, share_db => 1, require_objects => [ 'nicks', 'colors', 'other_obj' ], multi_many_ok => 1, sort_by => 't1.name'); is(scalar @$objs, 2, "get_objects() distinct multi many require $i.1 - $db_type"); is($objs->[0]->id, 5, "get_objects() distinct multi many require $i.2 - $db_type"); is($objs->[1]->id, 2, "get_objects() distinct multi many require $i.3 - $db_type"); ok(!defined $objs->[0]->{'nicks'}, "get_objects() distinct multi many require $i.4 - $db_type"); ok(!defined $objs->[0]->{'colors'}, "get_objects() distinct multi many require $i.5 - $db_type"); ok(!defined $objs->[1]->{'nicks'}, "get_objects() distinct multi many require $i.6 - $db_type"); ok(!defined $objs->[1]->{'colors'}, "get_objects() distinct multi many require $i.7 - $db_type"); } #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; foreach my $distinct ([ 't2' ], [ 'rose_db_object_nicks' ], [ 'nicks' ]) { $i++; $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', distinct => $distinct, share_db => 1, require_objects => [ 'nicks', 'colors', 'other_obj' ], multi_many_ok => 1, nonlazy => 1, sort_by => 't1.name'); is(scalar @$objs, 2, "get_objects() distinct multi many require $i.1 - $db_type"); is($objs->[0]->id, 5, "get_objects() distinct multi many require $i.2 - $db_type"); is($objs->[1]->id, 2, "get_objects() distinct multi many require $i.3 - $db_type"); ok(defined $objs->[0]->{'nicks'}, "get_objects() distinct multi many require $i.4 - $db_type"); ok(!defined $objs->[0]->{'colors'}, "get_objects() distinct multi many require $i.5 - $db_type"); ok(defined $objs->[1]->{'nicks'}, "get_objects() distinct multi many require $i.6 - $db_type"); ok(!defined $objs->[1]->{'colors'}, "get_objects() distinct multi many require $i.7 - $db_type"); } # End distinct tests # Start pager tests is(Rose::DB::Object::Manager->default_objects_per_page, 20, 'default_objects_per_page 1'); Rose::DB::Object::Manager->default_objects_per_page(3); my $per_page = Rose::DB::Object::Manager->default_objects_per_page; $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 1, per_page => 3); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 1.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 1); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 2.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', query => [ id => { le => 11 } ], sort_by => 't1.id', per_page => 3); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 3.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', query => [ id => { le => 11 } ], sort_by => 't1.id', per_page => -1); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 4.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => -1); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 5.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => undef); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 6.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', query => [ id => { le => 11 } ], sort_by => 't1.id', per_page => undef); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 7.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', query => [ id => { le => 11 } ], sort_by => 't1.id'); ok(scalar @$objs > 3, "pager 8 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 2, per_page => 3); $i = 0; for(4 .. 6) { is($objs->[$i++]->id, $_, "pager 9.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 3, per_page => 3); $i = 0; for(7 .. 9) { is($objs->[$i++]->id, $_, "pager 10.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 4, per_page => 3); $i = 0; for(10 .. 11) { is($objs->[$i++]->id, $_, "pager 11.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 5, per_page => 3); ok(scalar @$objs == 0, "pager 12 - $db_type"); Rose::DB::Object::Manager->default_objects_per_page(20); # End pager tests # Start get_objects_from_sql tests $objs = MyPgObjectManager->get_objects_from_sql( db => $db, object_class => 'MyPgObject', prepare_cached => 1, sql => <<"EOF"); SELECT * FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF ok(scalar @$objs == 19, "get_objects_from_sql 1 - $db_type"); is($objs->[18]->id, 1, "get_objects_from_sql 2 - $db_type"); is($objs->[18]->save_col, 5, "get_objects_from_sql 3 - $db_type"); is($objs->[18]->name, 'John', "get_objects_from_sql 4 - $db_type"); $iterator = MyPgObjectManager->get_objects_iterator_from_sql( db => MyPgObject->init_db, object_class => 'MyPgObject', prepare_cached => 1, sql => <<"EOF"); SELECT * FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF for(0 .. 17) { $iterator->next } $o = $iterator->next; is($o->id, 1, "get_objects_iterator_from_sql 1 - $db_type"); is($o->save_col, 5, "get_objects_iterator_from_sql 2 - $db_type"); is($o->name, 'John', "get_objects_iterator_from_sql 3 - $db_type"); ok(!$iterator->next, "get_objects_iterator_from_sql 4 - $db_type"); $objs = MyPgObjectManager->get_objects_from_sql(<<"EOF"); SELECT * FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF ok(scalar @$objs == 19, "get_objects_from_sql 5 - $db_type"); is($objs->[18]->id, 1, "get_objects_from_sql 6 - $db_type"); is($objs->[18]->save_col, 5, "get_objects_from_sql 7 - $db_type"); is($objs->[18]->name, 'John', "get_objects_from_sql 8 - $db_type"); $objs = MyPgObjectManager->get_objects_from_sql( db => $db, args => [ 19 ], sql => <<"EOF"); SELECT * FROM rose_db_object_test WHERE id > ? ORDER BY id DESC EOF ok(scalar @$objs == 2, "get_objects_from_sql 9 - $db_type"); is($objs->[0]->id, 60, "get_objects_from_sql 10 - $db_type"); my $method = MyPgObjectManager->make_manager_method_from_sql( get_em => <<"EOF"); SELECT *, save + fk1 AS extra FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF $objs = MyPgObjectManager->get_em; ok(scalar @$objs == 19, "make_manager_method_from_sql 1 - $db_type"); is($objs->[17]->id, 3, "make_manager_method_from_sql 2 - $db_type"); is($objs->[17]->extra, 7, "make_manager_method_from_sql 3 - $db_type"); is($objs->[17]->name, 'Sue', "make_manager_method_from_sql 4 - $db_type"); $objs = $method->('MyPgObjectManager'); ok(scalar @$objs == 19, "make_manager_method_from_sql 5 - $db_type"); is($objs->[17]->id, 3, "make_manager_method_from_sql 6 - $db_type"); is($objs->[17]->extra, 7, "make_manager_method_from_sql 7 - $db_type"); is($objs->[17]->name, 'Sue', "make_manager_method_from_sql 8 - $db_type"); $method = MyPgObjectManager->make_manager_method_from_sql( iterator => 1, method => 'iter_em', sql => <<"EOF"); SELECT *, save + fk1 AS extra FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF $iterator = MyPgObjectManager->iter_em; for(0 .. 16) { $iterator->next } $o = $iterator->next; is($objs->[17]->id, 3, "make_manager_method_from_sql iterator 1 - $db_type"); is($objs->[17]->extra, 7, "make_manager_method_from_sql iterator 2 - $db_type"); is($objs->[17]->name, 'Sue', "make_manager_method_from_sql iterator 3 - $db_type"); $iterator = $method->('MyPgObjectManager'); for(0 .. 16) { $iterator->next } $o = $iterator->next; is($objs->[17]->id, 3, "make_manager_method_from_sql iterator 4 - $db_type"); is($objs->[17]->extra, 7, "make_manager_method_from_sql iterator 5 - $db_type"); is($objs->[17]->name, 'Sue', "make_manager_method_from_sql iterator 6 - $db_type"); $method = MyPgObjectManager->make_manager_method_from_sql( get_more => <<"EOF"); SELECT *, save + fk1 AS extra FROM rose_db_object_test WHERE id > ? ORDER BY id DESC EOF $objs = MyPgObjectManager->get_more(18); ok(scalar @$objs == 3, "make_manager_method_from_sql 9 - $db_type"); is($objs->[2]->id, 19, "make_manager_method_from_sql 10 - $db_type"); $method = MyPgObjectManager->make_manager_method_from_sql( method => 'get_more_np', params => [ qw(id name) ], sql => <<"EOF"); SELECT *, save + fk1 AS extra FROM rose_db_object_test WHERE id > ? AND name != ? ORDER BY id DESC EOF $objs = MyPgObjectManager->get_more_np(name => 'Nonesuch', id => 18); ok(scalar @$objs == 3, "make_manager_method_from_sql 11 - $db_type"); is($objs->[2]->id, 19, "make_manager_method_from_sql 12 - $db_type"); # End get_objects_from_sql tests # Start tough order tests $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyPgObject', require_objects => [ 'nicks' ], nonlazy => 1); ok(@$objs == 5, "tough order 1 - $db_type"); is($objs->[0]->id, 2, "tough order 2 - $db_type"); is($objs->[1]->id, 5, "tough order 3 - $db_type"); is($objs->[2]->id, 10, "tough order 4 - $db_type"); is($objs->[3]->id, 11, "tough order 5 - $db_type"); is($objs->[4]->id, 12, "tough order 6 - $db_type"); is($objs->[0]{'nicks'}[0]{'nick'}, 'ntwo', "tough order 7 - $db_type"); is($objs->[0]{'nicks'}[1]{'nick'}, 'nfour', "tough order 8 - $db_type"); is($objs->[1]{'nicks'}[0]{'nick'}, 'nthree', "tough order 9 - $db_type"); is($objs->[1]{'nicks'}[1]{'nick'}, 'nsix', "tough order 10 - $db_type"); is($objs->[1]{'nicks'}[2]{'nick'}, 'none', "tough order 11 - $db_type"); is($objs->[1]{'nicks'}[3]{'nick'}, 'nfive', "tough order 12 - $db_type"); is($objs->[2]{'nicks'}[0]{'nick'}, 'nseven', "tough order 13 - $db_type"); is($objs->[3]{'nicks'}[0]{'nick'}, 'neight', "tough order 14 - $db_type"); is($objs->[4]{'nicks'}[0]{'nick'}, 'nnine', "tough order 15 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyPgObject', require_objects => [ 'nicks' ], nonlazy => 1, sort_by => 'name'); ok(@$objs == 5, "tough order 16 - $db_type"); is($objs->[0]->id, 5, "tough order 17 - $db_type"); is($objs->[1]->id, 10, "tough order 18 - $db_type"); is($objs->[2]->id, 11, "tough order 19 - $db_type"); is($objs->[3]->id, 12, "tough order 20 - $db_type"); is($objs->[4]->id, 2, "tough order 21 - $db_type"); is($objs->[0]{'nicks'}[0]{'nick'}, 'nthree', "tough order 22 - $db_type"); is($objs->[0]{'nicks'}[1]{'nick'}, 'nsix', "tough order 23 - $db_type"); is($objs->[0]{'nicks'}[2]{'nick'}, 'none', "tough order 24 - $db_type"); is($objs->[0]{'nicks'}[3]{'nick'}, 'nfive', "tough order 25 - $db_type"); is(scalar @{$objs->[0]{'nicks'}}, 4, "tough order 26 - $db_type"); is($objs->[1]{'nicks'}[0]{'nick'}, 'nseven', "tough order 27 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 1, "tough order 28 - $db_type"); is($objs->[2]{'nicks'}[0]{'nick'}, 'neight', "tough order 29 - $db_type"); is(scalar @{$objs->[2]{'nicks'}}, 1, "tough order 30 - $db_type"); is($objs->[3]{'nicks'}[0]{'nick'}, 'nnine', "tough order 31 - $db_type"); is(scalar @{$objs->[3]{'nicks'}}, 1, "tough order 32 - $db_type"); is($objs->[4]{'nicks'}[0]{'nick'}, 'ntwo', "tough order 33 - $db_type"); is($objs->[4]{'nicks'}[1]{'nick'}, 'nfour', "tough order 34 - $db_type"); is(scalar @{$objs->[4]{'nicks'}}, 2, "tough order 35 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyPgObject', require_objects => [ 'nicks' ], nonlazy => 1, sort_by => 'name'); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'nthree', "tough order 36 - $db_type"); is($o->{'nicks'}[1]{'nick'}, 'nsix', "tough order 37 - $db_type"); is($o->{'nicks'}[2]{'nick'}, 'none', "tough order 38 - $db_type"); is($o->{'nicks'}[3]{'nick'}, 'nfive', "tough order 39 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "tough order 40 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'nseven', "tough order 41 - $db_type"); is(scalar @{$o->{'nicks'}}, 1, "tough order 42 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'neight', "tough order 43 - $db_type"); is(scalar @{$o->{'nicks'}}, 1, "tough order 44 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'nnine', "tough order 45 - $db_type"); is(scalar @{$o->{'nicks'}}, 1, "tough order 46 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'ntwo', "tough order 47 - $db_type"); is($o->{'nicks'}[1]{'nick'}, 'nfour', "tough order 48 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "tough order 49 - $db_type"); ok(!$iterator->next, "tough order 50 - $db_type"); is($iterator->total, 5, "tough order 51 - $db_type"); # End tough order tests # Start deep join tests eval { Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', require_objects => [ 'nicks.type' ], with_objects => [ 'nicks.type' ]); }; ok($@, "deep join conflict 1 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( db => $db, #debug => 1, object_class => 'MyPgObject', require_objects => [ 'nicks.type', 'nicks.type', 'nicks' ], with_objects => [ 'nicks.type.t2', 'nicks.alts' ], multi_many_ok => 1, nonlazy => 1, query => [ 'id' => [ 2, 5 ] ], sort_by => 'type.name'); ok(@$objs == 2, "deep join 1 - $db_type"); is($objs->[0]->id, 2, "deep join 2 - $db_type"); is($objs->[1]->id, 5, "deep join 3 - $db_type"); #SORT: #{ # $objs->[0]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[0]{'nicks'}} ]; #} is($objs->[0]{'nicks'}[0]{'type'}{'name'}, 'nt four', "deep join 4 - $db_type"); is($objs->[0]{'nicks'}[1]{'type'}{'name'}, 'nt two', "deep join 5 - $db_type"); is(scalar @{$objs->[0]{'nicks'}}, 2, "deep join 6 - $db_type"); #SORT: #{ # $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; #} is($objs->[1]{'nicks'}[0]{'type'}{'name'}, 'nt five', "deep join 7 - $db_type"); is($objs->[1]{'nicks'}[1]{'type'}{'name'}, 'nt one', "deep join 8 - $db_type"); is($objs->[1]{'nicks'}[2]{'type'}{'name'}, 'nt six', "deep join 9 - $db_type"); is($objs->[1]{'nicks'}[3]{'type'}{'name'}, 'nt three', "deep join 10 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 4, "deep join 11 - $db_type"); is($objs->[0]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join 12 - $db_type"); is($objs->[0]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join 13 - $db_type"); is($objs->[0]{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt two 1', "deep join 14 - $db_type"); $objs->[1]{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$objs->[1]{'nicks'}[1]{'alts'}} ]; is($objs->[1]{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt one 1', "deep join 15 - $db_type"); is($objs->[1]{'nicks'}[1]{'alts'}[1]{'alt'}, 'alt one 2', "deep join 16 - $db_type"); is($objs->[1]{'nicks'}[1]{'alts'}[2]{'alt'}, 'alt one 3', "deep join 17 - $db_type"); is(scalar @{$objs->[1]{'nicks'}[1]{'alts'}}, 3, "deep join 18 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', with_objects => [ 'nicks.type' ], nonlazy => 1, sort_by => 'type.name'); ok(@$objs == 21, "deep join with 1 - $db_type"); is($objs->[0]->id, 1, "deep join with 2 - $db_type"); is($objs->[1]->id, 2, "deep join with 3 - $db_type"); is($objs->[2]->id, 3, "deep join with 4 - $db_type"); is($objs->[16]->id, 17, "deep join with 5 - $db_type"); #SORT: #{ # $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; #} is($objs->[1]{'nicks'}[0]{'type'}{'name'}, 'nt four', "deep join with 6 - $db_type"); is($objs->[1]{'nicks'}[1]{'type'}{'name'}, 'nt two', "deep join with 7 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 2, "deep join with 8 - $db_type"); #SORT: #{ # $objs->[4]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[4]{'nicks'}} ]; #} is($objs->[4]{'nicks'}[0]{'type'}{'name'}, 'nt five', "deep join with 9 - $db_type"); is($objs->[4]{'nicks'}[1]{'type'}{'name'}, 'nt one', "deep join with 10 - $db_type"); is($objs->[4]{'nicks'}[2]{'type'}{'name'}, 'nt six', "deep join with 11 - $db_type"); is($objs->[4]{'nicks'}[3]{'type'}{'name'}, 'nt three', "deep join with 12 - $db_type"); is(scalar @{$objs->[4]{'nicks'}}, 4, "deep join with 13 - $db_type"); is(scalar @{$objs->[0]{'nicks'} ||= []}, 0, "deep join with 14 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( db => $db, object_class => 'MyPgObject', require_objects => [ 'nicks.type', 'nicks.type', 'nicks' ], with_objects => [ 'nicks.type.t2', 'nicks.alts' ], multi_many_ok => 1, query => [ 'id' => [ 2, 5 ] ], sort_by => 'type.name'); $o = $iterator->next; is($o->{'nicks'}[0]{'type'}{'name'}, 'nt four', "deep join iterator 1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'name'}, 'nt two', "deep join iterator 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "deep join iterator 3 - $db_type"); is($o->{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt two 1', "deep join 3.1 - $db_type"); is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join iterator 3.1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join iterator 3.2 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'type'}{'name'}, 'nt five', "deep join iterator 4 - $db_type"); is($o->{'nicks'}[1]{'type'}{'name'}, 'nt one', "deep join iterator 5 - $db_type"); is($o->{'nicks'}[2]{'type'}{'name'}, 'nt six', "deep join iterator 6 - $db_type"); is($o->{'nicks'}[3]{'type'}{'name'}, 'nt three', "deep join iterator 7 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "deep join iterator 8 - $db_type"); $o->{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$o->{'nicks'}[1]{'alts'}} ]; is($o->{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt one 1', "deep join iterator 9 - $db_type"); is($o->{'nicks'}[1]{'alts'}[1]{'alt'}, 'alt one 2', "deep join iterator 10 - $db_type"); is($o->{'nicks'}[1]{'alts'}[2]{'alt'}, 'alt one 3', "deep join iterator 11 - $db_type"); is(scalar @{$o->{'nicks'}[1]{'alts'}}, 3, "deep join iterator 12 - $db_type"); ok(!$iterator->next, "deep join iterator 13 - $db_type"); is($iterator->total, 2, "deep join iterator 14 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( db => $db, object_class => 'MyPgObject', with_objects => [ 'nicks.type' ], nonlazy => 1, sort_by => 'type.name'); $o = $iterator->next; is($o->id, 1, "deep join with with iterator 1 - $db_type"); $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; #} is($o->{'nicks'}[0]{'type'}{'name'}, 'nt four', "deep join with with iterator 1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'name'}, 'nt two', "deep join with iterator 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "deep join with iterator 3 - $db_type"); $o = $iterator->next; $o = $iterator->next; $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; #} is($o->{'nicks'}[0]{'type'}{'name'}, 'nt five', "deep join with iterator 4 - $db_type"); is($o->{'nicks'}[1]{'type'}{'name'}, 'nt one', "deep join with iterator 5 - $db_type"); is($o->{'nicks'}[2]{'type'}{'name'}, 'nt six', "deep join with iterator 6 - $db_type"); is($o->{'nicks'}[3]{'type'}{'name'}, 'nt three', "deep join with iterator 7 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "deep join with iterator 8 - $db_type"); while($iterator->next) { } is($iterator->total, 21, "deep join iterator 9 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', require_objects => [ 'nicks.type.t2' ], query => [ 'id' => [ 2, 5 ] ], nonlazy => 1, sort_by => 'type.name'); ok(@$objs == 2, "deep join three-level 1 - $db_type"); is($objs->[0]->id, 2, "deep join three-level 2 - $db_type"); is($objs->[1]->id, 5, "deep join three-level 3 - $db_type"); #SORT: #{ # $objs->[0]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[0]{'nicks'}} ]; #} is($objs->[0]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join three-level 4 - $db_type"); is($objs->[0]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join three-level 5 - $db_type"); is(scalar @{$objs->[0]{'nicks'}}, 2, "deep join three-level 6 - $db_type"); #SORT: #{ # $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; #} is($objs->[1]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 five', "deep join three-level 7 - $db_type"); is($objs->[1]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 one', "deep join three-level 8 - $db_type"); is($objs->[1]{'nicks'}[2]{'type'}{'t2'}{'name'}, 'nt2 six', "deep join three-level 9 - $db_type"); is($objs->[1]{'nicks'}[3]{'type'}{'t2'}{'name'}, 'nt2 three', "deep join three-level 10 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 4, "deep join three-level 11 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', with_objects => [ 'nicks.type.t2' ], nonlazy => 1, sort_by => 'type.name'); ok(@$objs == 21, "deep join three-level 1 - $db_type"); is($objs->[0]->id, 1, "deep join three-level 2 - $db_type"); is($objs->[1]->id, 2, "deep join three-level 3 - $db_type"); is($objs->[4]->id, 5, "deep join three-level 4 - $db_type"); is($objs->[20]->id, 60, "deep join three-level 5 - $db_type"); #SORT: #{ # $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; #} is($objs->[1]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join three-level 6 - $db_type"); is($objs->[1]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join three-level 7 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 2, "deep join three-level 8 - $db_type"); #SORT: #{ # $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; #} is($objs->[4]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 five', "deep join three-level 9 - $db_type"); is($objs->[4]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 one', "deep join three-level 10 - $db_type"); is($objs->[4]{'nicks'}[2]{'type'}{'t2'}{'name'}, 'nt2 six', "deep join three-level 11 - $db_type"); is($objs->[4]{'nicks'}[3]{'type'}{'t2'}{'name'}, 'nt2 three', "deep join three-level 12 - $db_type"); is(scalar @{$objs->[4]{'nicks'}}, 4, "deep join three-level 13 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( db => $db, object_class => 'MyPgObject', require_objects => [ 'nicks.type.t2' ], query => [ 'id' => [ 2, 5 ] ], sort_by => 'type.name'); $o = $iterator->next; is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join iterator 1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join iterator 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "deep join iterator 3 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 five', "deep join iterator 4 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 one', "deep join iterator 5 - $db_type"); is($o->{'nicks'}[2]{'type'}{'t2'}{'name'}, 'nt2 six', "deep join iterator 6 - $db_type"); is($o->{'nicks'}[3]{'type'}{'t2'}{'name'}, 'nt2 three', "deep join iterator 7 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "deep join iterator 8 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( db => $db, object_class => 'MyPgObject', with_objects => [ 'nicks.type.t2' ], nonlazy => 1, sort_by => 'type.name'); $o = $iterator->next; $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; #} is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join iterator with 1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join iterator with 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "deep join iterator with 3 - $db_type"); $o = $iterator->next; $o = $iterator->next; $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; #} is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 five', "deep join iterator with 4 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 one', "deep join iterator with 5 - $db_type"); is($o->{'nicks'}[2]{'type'}{'t2'}{'name'}, 'nt2 six', "deep join iterator with 6 - $db_type"); is($o->{'nicks'}[3]{'type'}{'t2'}{'name'}, 'nt2 three', "deep join iterator with 7 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "deep join iterator with 8 - $db_type"); while($iterator->next) { } is($iterator->total, 21, "deep join iterator with 9 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', require_objects => [ 'nicks.alts' ], multi_many_ok => 1, query => [ 'id' => [ 2, 5 ] ], sort_by => 'alts.alt'); ok(@$objs == 2, "deep join multi 1 - $db_type"); is($objs->[0]->id, 2, "deep join multi 2 - $db_type"); is($objs->[1]->id, 5, "deep join multi 3 - $db_type"); is($objs->[0]{'nicks'}[0]{'alts'}[0]{'alt'}, 'alt two 1', "deep join multi 4 - $db_type"); is(scalar @{$objs->[0]{'nicks'}[0]{'alts'}}, 1, "deep join multi 5 - $db_type"); is($objs->[1]{'nicks'}[0]{'alts'}[0]{'alt'}, 'alt one 1', "deep join multi 6 - $db_type"); is($objs->[1]{'nicks'}[0]{'alts'}[1]{'alt'}, 'alt one 2', "deep join multi 7 - $db_type"); is($objs->[1]{'nicks'}[0]{'alts'}[2]{'alt'}, 'alt one 3', "deep join multi 8 - $db_type"); is(scalar @{$objs->[1]{'nicks'}[0]{'alts'}}, 3, "deep join multi 11 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', with_objects => [ 'nicks.alts' ], multi_many_ok => 1, nonlazy => 1, sort_by => 'alts.alt'); ok(@$objs == 21, "deep join multi with 1 - $db_type"); is($objs->[1]->id, 2, "deep join multi with 2 - $db_type"); is($objs->[4]->id, 5, "deep join multi with 3 - $db_type"); SORT: { $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; $objs->[1]{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$objs->[1]{'nicks'}[1]{'alts'}} ]; } is($objs->[1]{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt two 1', "deep join multi with with 4 - $db_type"); is(scalar @{$objs->[1]{'nicks'}[1]{'alts'}}, 1, "deep join multi with 5 - $db_type"); SORT: { $objs->[4]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[4]{'nicks'}} ]; $objs->[4]{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$objs->[4]{'nicks'}[1]{'alts'}} ]; } is($objs->[4]{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt one 1', "deep join multi with 6 - $db_type"); is($objs->[4]{'nicks'}[1]{'alts'}[1]{'alt'}, 'alt one 2', "deep join multi with 7 - $db_type"); is($objs->[4]{'nicks'}[1]{'alts'}[2]{'alt'}, 'alt one 3', "deep join multi with 8 - $db_type"); is(scalar @{$objs->[4]{'nicks'}[1]{'alts'}}, 3, "deep join multi with 11 - $db_type"); is(scalar @{$objs->[0]{'nicks'} || []}, 0, "deep join multi with 12 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( db => $db, object_class => 'MyPgObject', require_objects => [ 'nicks.alts' ], multi_many_ok => 1, query => [ 'id' => [ 2, 5 ] ], sort_by => 'alts.alt'); $o = $iterator->next; is($o->id, 2, "deep join multi iter 1 - $db_type"); is($o->{'nicks'}[0]{'alts'}[0]{'alt'}, 'alt two 1', "deep join multi iter 2 - $db_type"); is(scalar @{$o->{'nicks'}[0]{'alts'}}, 1, "deep join multi iter 3 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'alts'}[0]{'alt'}, 'alt one 1', "deep join multi iter 4 - $db_type"); is($o->{'nicks'}[0]{'alts'}[1]{'alt'}, 'alt one 2', "deep join multi iter 5 - $db_type"); is($o->{'nicks'}[0]{'alts'}[2]{'alt'}, 'alt one 3', "deep join multi iter 6 - $db_type"); is(scalar @{$o->{'nicks'}[0]{'alts'}}, 3, "deep join multi iter 7 - $db_type"); ok(!$iterator->next, "deep join multi iter 8 - $db_type"); is($iterator->total, 2, "deep join multi iter 9 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( db => $db, object_class => 'MyPgObject', with_objects => [ 'nicks.alts' ], multi_many_ok => 1, nonlazy => 1, #query => [ id => 2 ], sort_by => 'alts.alt'); $o = $iterator->next; is(scalar @{$o->{'nicks'} ||= []}, 0, "deep join multi iter with 1 - $db_type"); $o = $iterator->next; SORT: { $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; $o->{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$o->{'nicks'}[1]{'alts'}} ]; } is($o->id, 2, "deep join multi iter with 2 - $db_type"); is($o->{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt two 1', "deep join multi iter with 3 - $db_type"); is(scalar @{$o->{'nicks'}[1]{'alts'}}, 1, "deep join multi iter with 4 - $db_type"); $o = $iterator->next; $o = $iterator->next; $o = $iterator->next; SORT: { $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; $o->{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$o->{'nicks'}[1]{'alts'}} ]; } is($o->{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt one 1', "deep join multi iter with 5 - $db_type"); is($o->{'nicks'}[1]{'alts'}[1]{'alt'}, 'alt one 2', "deep join multi iter with 6 - $db_type"); is($o->{'nicks'}[1]{'alts'}[2]{'alt'}, 'alt one 3', "deep join multi iter with 7 - $db_type"); is(scalar @{$o->{'nicks'}[1]{'alts'}}, 3, "deep join multi iter with 8 - $db_type"); while($iterator->next) { } is($iterator->total, 21, "deep join multi iter with 9 - $db_type"); # End deep join tests # Start custom select tests my @selects = ( 't2.nick, id, t2.id, name, UPPER(name) AS derived, fk1', 't1.id, t2.nick, t2.id, t1.name, UPPER(name) AS derived, t1.fk1', 'rose_db_object_nicks.id, rose_db_object_test.id, rose_db_object_nicks.nick, rose_db_object_test.name, UPPER(name) AS derived', [ \q(t1.id + 0 AS id), qw(name t2.nick nicks.id), \q(UPPER(name) AS derived) ], [ qw(t2.nick t2.id t1.id t1.name), 'UPPER(name) AS derived' ], [ \q(UPPER(name) AS derived), qw(t2.id rose_db_object_nicks.nick rose_db_object_test.id rose_db_object_test.name) ], [ qw(rose_db_object_test.id rose_db_object_nicks.nick rose_db_object_test.name rose_db_object_nicks.id), 'UPPER(name) AS derived' ], [ qw(rose_db_object_test.id rose_db_object_test.name rose_db_object_nicks.nick t2.id), 'UPPER(name) AS derived' ], ); $i = 0; #local $Rose::DB::Object::Manager::Debug = 1; foreach my $select (@selects) { $iterator = Rose::DB::Object::Manager->get_objects_iterator( db => $db, object_class => 'MyPgObject', select => $select, require_objects => [ 'nicks' ], query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->nicks->[0]->nick && !defined $o->nicks->[0]->type_id && !defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->nicks->[0]->nick && !defined $o->nicks->[0]->type_id && !defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; ok(!$iterator->next, "custom select $i - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( db => $db, object_class => 'MyPgObject', select => $select, require_objects => [ 'nicks' ], query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; ok($objs->[0]->id > 2 && defined $objs->[0]->name && defined $objs->[0]->nicks->[0]->nick && !defined $objs->[0]->nicks->[0]->type_id && !defined $objs->[0]->flag2 && $objs->[0]->derived eq 'DERIVED: ' . uc($objs->[0]->name), "custom select $i - $db_type"); $i++; ok($objs->[1]->id > 2 && defined $objs->[1]->name && defined $objs->[1]->nicks->[0]->nick && !defined $objs->[1]->nicks->[0]->type_id && !defined $objs->[1]->flag2 && $objs->[1]->derived eq 'DERIVED: ' . uc($objs->[1]->name), "custom select $i - $db_type"); $i++; is(scalar @$objs, 2, "custom select $i - $db_type"); } @selects = ( 't2.nick, t1.*, t2.id, name, UPPER(name) AS derived', [ qw(t2.nick t2.id t1.*), 'UPPER(name) AS derived' ], ); #local $Rose::DB::Object::Manager::Debug = 1; foreach my $select (@selects) { $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyPgObject', select => $select, require_objects => [ 'nicks' ], query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->nicks->[0]->nick && !defined $o->nicks->[0]->type_id && defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->nicks->[0]->nick && !defined $o->nicks->[0]->type_id && defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; ok(!$iterator->next, "custom select $i - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyPgObject', select => $select, require_objects => [ 'nicks' ], query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; ok($objs->[0]->id > 2 && defined $objs->[0]->name && defined $objs->[0]->nicks->[0]->nick && !defined $objs->[0]->nicks->[0]->type_id && defined $objs->[0]->flag2 && $objs->[0]->derived eq 'DERIVED: ' . uc($objs->[0]->name), "custom select $i - $db_type"); $i++; ok($objs->[1]->id > 2 && defined $objs->[1]->name && defined $objs->[1]->nicks->[0]->nick && !defined $objs->[1]->nicks->[0]->type_id && defined $objs->[1]->flag2 && $objs->[1]->derived eq 'DERIVED: ' . uc($objs->[1]->name), "custom select $i - $db_type"); $i++; is(scalar @$objs, 2, "custom select $i - $db_type"); } @selects = ( '*, name, UPPER(name) AS derived', [ '*', 'UPPER(name) AS derived' ], ); #local $Rose::DB::Object::Manager::Debug = 1; foreach my $select (@selects) { $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyPgObject', select => $select, query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; ok(!$iterator->next, "custom select $i - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyPgObject', select => $select, query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; ok($objs->[0]->id > 2 && defined $objs->[0]->name && defined $objs->[0]->flag2 && $objs->[0]->derived eq 'DERIVED: ' . uc($objs->[0]->name), "custom select $i - $db_type"); $i++; ok($objs->[1]->id > 2 && defined $objs->[1]->name && defined $objs->[1]->flag2 && $objs->[1]->derived eq 'DERIVED: ' . uc($objs->[1]->name), "custom select $i - $db_type"); $i++; is(scalar @$objs, 2, "custom select $i - $db_type"); } # End custom select tests # End test of the subselect limit code #Rose::DB::Object::Manager->default_limit_with_subselect(0); } # # MySQL # SKIP: foreach my $db_type ('mysql') { skip("MySQL tests", 791) unless($HAVE_MYSQL); Rose::DB->default_type($db_type); Rose::DB->default_keyword_function_calls(1); my $o = MyMySQLObject->new(id => 1, name => 'John', flag => 1, flag2 => 0, fkone => 2, status => 'active', bits => '00001', start => '2001-01-02', save_col => 5, nums => [ 1, 2, 3 ], last_modified => 'now', date_created => '2004-03-30 12:34:56'); ok($o->save, "object save() 1 - $db_type"); my $msql_5 = ($o->db->database_version >= 5_000_003) ? 1 : 0; #local $Rose::DB::Object::Manager::Debug = 1; my $objs = MyMySQLObject->get_objectz( #debug => 1, share_db => 1, #hints => { calc_found_rows => 1, high_priority => 1, small_result => 1 }, #hints => { rose_db_object_test => { calc_found_rows => 1, high_priority => 1, small_result => 1 } }, #hints => { t1 => { calc_found_rows => 1, high_priority => 1, small_result => 1 } }, query => [ id => { ge => 1 }, id => { ge => 1 }, id => [ \'1', \'id' ], #' id => { gt_lt => [ -1, 991 ] }, id => { gt_le => [ -1, 992 ] }, id => { ge_lt => [ -1, 993 ] }, id => { ge_le => [ -1, 994 ] }, id => { gt_lt_sql => [ -1, 991 ] }, id => { gt_le_sql => [ -1, 992 ] }, id => { ge_lt_sql => [ -1, 993 ] }, id => { ge_le_sql => [ -1, 994 ] }, id => { gt_lt => [ -1, \991 ] }, id => { gt_le => [ \-1, 992 ] }, id => { ge_lt => [ -1, \993 ] }, id => { ge_le => [ \-1, 994 ] }, id => { between => [ 0, 99 ] }, id => { between => [ 0, \q(101) ] }, id => { between => [ \1, 99 ] }, name => 'John', flag => 1, flag2 => 0, \q((1 = 1 and 5 > 2)), [ \q(fk1 > ?), 1 ], or => [ bits => '00001', \q((2 = 2 and 6 > 3)), fk1 => { gt => 1 }, and => [ status => 'active', status => { ne_sql => "'active'" }, [ \q(7 > ?), 3 ], ], ], status => 'active', bits => '00001', ($msql_5 ? (items => { any_in_set => [ 'a', 'c' ] }) : ()), ($msql_5 ? (items => { any_in_set_sql => [ q('a'), q('c') ] }) : ()), ($msql_5 ? ('!items' => { any_in_set => [ 'x', 'y' ] }) : ()), ($msql_5 ? (items => { all_in_set => [ 'a', 'c' ] }) : ()), ($msql_5 ? ('!items' => { all_in_set => [ 'a', 'x' ] }) : ()), ($msql_5 ? (items => { in_set => 'a' }) : ()), ($msql_5 ? ('!items' => { in_set => 'x' }) : ()), ($msql_5 ? (items => { all_in_set => 'c' }) : ()), ($msql_5 ? (items => { '&' => 1 }) : ()), fixed => { like => 'nee%' }, or => [ and => [ '!bits' => '00001', bits => { ne => '11111' } ], and => [ bits => { lt => '10101' }, '!bits' => '10000' ] ], start => '2001-01-02', start => { le => \q(NOW()) }, start => { between => [ '1/1/1999', 'NOW()' ] }, start => { between_sql => [ "'1999-02-02'", 'NOW()' ] }, save_col => [ 1, 5 ], last_modified => { le => 'now' }, date_created => '2004-03-30 12:34:56', ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() 2 - $db_type"); my $o2 = $o->clone; $o2->id(2); $o2->name('Fred'); ok($o2->save, "object save() 2 - $db_type"); my $o3 = $o2->clone; $o3->id(3); $o3->name('Sue'); ok($o3->save, "object save() 3 - $db_type"); my $o4 = $o3->clone; $o4->id(4); $o4->name('Bob'); ok($o4->save, "object save() 4 - $db_type"); eval { $objs = MyMySQLObjectManager->get_objectz( query => [ date_created => '205-1-2', # invalid date ]); }; ok($@, "Invalid date - $db_type"); eval { $objs = MyMySQLObjectManager->get_objectz( query => [ flag => [] ]); }; ok($@, "Empty list 1 - $db_type"); $objs = MyMySQLObjectManager->get_objectz( allow_empty_lists => 1, query => [ flag => [] ]); is(scalar @$objs, 4, "Empty list 2 - $db_type"); eval { $objs = MyMySQLObjectManager->get_objectz( query => [ or => [ flag => 1, status => [] ] ]); }; ok($@, "Empty list 3 - $db_type"); $objs = MyMySQLObjectManager->get_objectz( allow_empty_lists => 1, query => [ or => [ flag => 1, status => [] ] ]); is(scalar @$objs, 4, "Empty list 4 - $db_type"); $objs = MyMySQLObjectManager->get_objectz( share_db => 1, query => [ id => { ge => 2 }, name => { like => '%e%' }, flag => 1, flag2 => 0, status => 'active', bits => '00001', start => '2001-01-02', save_col => [ 1, 5 ], last_modified => { le => 'now' }, date_created => '2004-03-30 12:34:56', status => { like => 'AC%', field => 'UPPER(status)' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'name DESC'); is(ref $objs, 'ARRAY', "get_objects() 3 - $db_type"); $objs ||= []; is(scalar @$objs, 2, "get_objects() 4 - $db_type"); is($objs->[0]->id, 3, "get_objects() 5 - $db_type"); is($objs->[1]->id, 2, "get_objects() 6 - $db_type"); my $count = MyMySQLObject->get_objectz_count( #debug => 1, with_objects => [ 'bb1', 'nicks', 'bb2' ], share_db => 1, query => [ id => { ge => 2 }, name => { like => '%e%' }, flag => 1, flag2 => 0, status => 'active', bits => '00001', start => '2001-01-02', save_col => [ 1, 5 ], last_modified => { le => 'now' }, date_created => '2004-03-30 12:34:56', status => { like => 'AC%', field => 'UPPER(status)' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], sort_by => 'name DESC'); is($count, 2, "get_objects_count() 1 - $db_type"); # Set up sub-object for this one test my $b1 = MyMySQLBB->new(id => 1, name => 'one'); $b1->save; $objs->[0]->b1(1); $objs->[0]->save; #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; $count = MyMySQLObjectManager->get_objectz_count( share_db => 1, query_is_sql => 1, require_objects => [ 'bb1' ], query => [ 't2.name' => { like => 'o%' }, 't2_name' => { like => 'on%' }, 'bb1.name' => { like => '%n%' }, 'id' => { ge => 2 }, 'name' => { like => '%e%' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'name DESC'); is($count, 1, "get_objects_count() require 1 - $db_type"); # Clear sub-object $objs->[0]->b1(undef); $objs->[0]->save; $b1->delete; my $iterator = MyMySQLObjectManager->get_objectz_iterator( share_db => 1, query => [ id => { ge => 2 }, name => { like => '%e%' }, flag => 1, flag2 => 0, status => 'active', bits => '00001', start => '2001-01-02', save_col => [ 1, 5 ], last_modified => { le => 'now' }, date_created => '2004-03-30 12:34:56', status => { like => 'AC%', field => 'UPPER(status)' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'name'); is(ref $iterator, 'Rose::DB::Object::Iterator', "get_objects_iterator() 3 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "iterator next() 1 - $db_type"); is($o->id, 2, "iterator next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Sue', "iterator next() 3 - $db_type"); is($o->id, 3, "iterator next() 4 - $db_type"); $o = $iterator->next; is($o, 0, "iterator next() 5 - $db_type"); is($iterator->total, 2, "iterator total() - $db_type"); my $fo = MyMySQLOtherObject->new(name => 'Foo 1', k1 => 1, k2 => 2, k3 => 3); ok($fo->save, "object save() 5 - $db_type"); $fo = MyMySQLOtherObject->new(name => 'Foo 2', k1 => 2, k2 => 3, k3 => 4); ok($fo->save, "object save() 6 - $db_type"); $fo = MyMySQLBB->new(id => 1, name => 'one'); ok($fo->save, "bb object save() 1 - $db_type"); $fo = MyMySQLBB->new(id => 2, name => 'two'); ok($fo->save, "bb object save() 2 - $db_type"); $fo = MyMySQLBB->new(id => 3, name => 'three'); ok($fo->save, "bb object save() 3 - $db_type"); $fo = MyMySQLBB->new(id => 4, name => 'four'); ok($fo->save, "bb object save() 4 - $db_type"); my $o5 = MyMySQLObject->new(id => 5, name => 'Betty', flag => 'f', flag2 => 't', status => 'with', bits => '10101', start => '2002-05-20', save_col => 123, nums => [ 4, 5, 6 ], fkone => 1, fk2 => 2, fk3 => 3, b1 => 2, b2 => 4, last_modified => '2001-01-10 20:34:56', date_created => '2002-05-10 10:34:56'); ok($o5->save, "object save() 7 - $db_type"); my $fo1 = $o5->other_obj; ok($fo1 && ref $fo1 && $fo1->k1 == 1 && $fo1->k2 == 2 && $fo1->k3 == 3, "foreign object 1 - $db_type"); $fo1 = $o5->bb1; ok($fo1 && ref $fo1 && $fo1->id == 2, "bb foreign object 1 - $db_type"); $fo1 = $o5->bb2; ok($fo1 && ref $fo1 && $fo1->id == 4, "bb foreign object 2 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; # Conservative version check for hints support if($objs->[0]->db->database_version >= 4_000_009) { my $sql = Rose::DB::Object::Manager->get_objects_sql( object_class => 'MyMySQLObject', share_db => 1, with_objects => [ 'bb1' ], query => [ 't1.id' => { ge => 2 }, 't1.name' => { like => '%tt%' }, ], unique_aliases => 1, hints => { t1 => { ignore_index => 'rose_db_object_test_idx' } }); $objs = MyMySQLObject->get_objectz( object_class => 'MyMySQLObject', share_db => 1, query => [ 't1.id' => { ge => 2 }, 't1.name' => { like => '%tt%' }, ], hints => { t1 => { ignore_index => 'rose_db_object_test_idx' } }); ok($sql =~ m{\bIGNORE INDEX \(rose_db_object_test_idx\)}, "hints single table - $db_type"); ok($sql =~ m{ t1_name,}, "unique_aliases 1 - $db_type"); $sql = Rose::DB::Object::Manager->get_objects_sql( object_class => 'MyMySQLObject', share_db => 1, with_objects => [ 'bb1' ], query => [ 't1.id' => { ge => 2 }, 't1.name' => { like => '%tt%' }, ], hints => { ignore_index => 'rose_db_object_test_idx' }); $objs = MyMySQLObject->get_objectz( object_class => 'MyMySQLObject', share_db => 1, query => [ 't1.id' => { ge => 2 }, 't1.name' => { like => '%tt%' }, ], hints => { ignore_index => 'rose_db_object_test_idx' }); ok($sql =~ m{\bIGNORE INDEX \(rose_db_object_test_idx\)}, "hints single table 2 - $db_type"); ok($sql !~ m{ t1_name,}, "unique_aliases 2 - $db_type"); $sql = Rose::DB::Object::Manager->get_objects_sql( object_class => 'MyMySQLObject', share_db => 1, query => [ 't1.id' => { ge => 2 }, 't1.name' => { like => '%tt%' }, ], hints => { rose_db_object_test => { ignore_index => 'rose_db_object_test_idx' } }); $objs = MyMySQLObject->get_objectz( object_class => 'MyMySQLObject', share_db => 1, query => [ 't1.id' => { ge => 2 }, 't1.name' => { like => '%tt%' }, ], hints => { rose_db_object_test => { ignore_index => 'rose_db_object_test_idx' } }); ok($sql =~ m{\bIGNORE INDEX \(rose_db_object_test_idx\)}, "hints single table 3 - $db_type"); } else { SKIP: { skip("hints single table - $db_type", 3) } } # Conservative version check for select-for-update support if($objs->[0]->db->database_version >= 5_000_000) { my $db = Rose::DB->new; $db->begin_work; my $sql = Rose::DB::Object::Manager->get_objects_sql( object_class => 'MyMySQLObject', db => $db, share_db => 1, with_objects => [ 'bb1' ], for_update => 1, query => [ 't1.id' => { ge => 2 }, 't1.name' => { like => '%tt%' }, ]); $objs = MyMySQLObject->get_objectz( object_class => 'MyMySQLObject', db => $db, share_db => 1, for_update => 1, #debug => 1, query => [ 't1.id' => { ge => 2 }, 't1.name' => { like => '%tt%' }, ]); ok($sql =~ m{\bFOR UPDATE\b}, "select for update - $db_type"); $db->begin_work; $sql = Rose::DB::Object::Manager->get_objects_sql( object_class => 'MyMySQLObject', db => $db, share_db => 1, with_objects => [ 'bb1' ], lock => { type => 'shared' }, query => [ 't1.id' => { ge => 2 }, 't1.name' => { like => '%tt%' }, ]); $objs = MyMySQLObject->get_objectz( object_class => 'MyMySQLObject', db => $db, share_db => 1, lock => { type => 'shared' }, query => [ 't1.id' => { ge => 2 }, 't1.name' => { like => '%tt%' }, ]); ok($sql =~ m{\bLOCK IN SHARE MODE\b}, "select lock shared - $db_type"); $db->commit; } else { SKIP: { skip("select for update - $db_type", 2) } } $objs = MyMySQLObject->get_objectz( object_class => 'MyMySQLObject', share_db => 1, query => [ 't1.id' => { ge => 2 }, 't1.name' => { like => '%tt%' }, ], require_objects => [ 'other_obj', 'bb1', 'bb2' ], hints => { t2 => { ignore_index => 'rose_db_object_other_idx', use_index => 'rose_db_object_other_idx2' } }); ok(ref $objs->[0]->{'other_obj'} eq 'MyMySQLOtherObject', "foreign object 2 - $db_type"); is($objs->[0]->other_obj->k2, 2, "foreign object 3 - $db_type"); is($objs->[0]->bb1->name, 'two', "bb foreign object 3 - $db_type"); is($objs->[0]->bb2->name, 'four', "bb foreign object 4 - $db_type"); # Start "one to many" tests ok($fo = MyMySQLNick->new(id => 1, o_id => 5, nick => 'none', type => { name => 'nt one', t2 => { name => 'nt2 one' } }, alts => [ { alt => 'alt one 1' }, { alt => 'alt one 2' }, { alt => 'alt one 3' }, ], opts => [ { opt => 'opt one 1' }, { opt => 'opt one 2' } ])->save, "nick object save() 1 - $db_type"); $fo = MyMySQLNick->new(id => 2, o_id => 2, nick => 'ntwo', type => { name => 'nt two', t2 => { name => 'nt2 two' } }, alts => [ { alt => 'alt two 1' } ]); ok($fo->save, "nick object save() 2 - $db_type"); $fo = MyMySQLNick->new(id => 3, o_id => 5, nick => 'nthree', type => { name => 'nt three', t2 => { name => 'nt2 three' } }, opts => [ { opt => 'opt three 1' }, { opt => 'opt three 2' } ]); ok($fo->save, "nick object save() 3 - $db_type"); $fo = MyMySQLNick->new(id => 4, o_id => 2, nick => 'nfour', type => { name => 'nt four', t2 => { name => 'nt2 four' } }); ok($fo->save, "nick object save() 4 - $db_type"); $fo = MyMySQLNick->new(id => 5, o_id => 5, nick => 'nfive', type => { name => 'nt five', t2 => { name => 'nt2 five' } }); ok($fo->save, "nick object save() 5 - $db_type"); $fo = MyMySQLNick->new(id => 6, o_id => 5, nick => 'nsix', type => { name => 'nt six', t2 => { name => 'nt2 six' } }); ok($fo->save, "nick object save() 6 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', share_db => 1, with_objects => [ 'nicks' ], query => [ 't1.id' => { ge => 1 }, 't1.name' => 'Betty', flag => 'f', flag2 => 1, bits => '10101', 't2.nick' => { like => 'n%' }, start => '5/20/2002', '!start' => { gt => DateTime->new(year => '2005', month => 12, day => 1) }, '!rose_db_object_test.start' => { gt => DateTime->new(year => '2005', month => 12, day => 2) }, '!t1.start' => { gt => DateTime->new(year => '2005', month => 12, day => 3) }, or => [], and => [], save_col => [ 1, 5, 123 ], nums => [ 4, 5, 6 ], fk1 => 1, last_modified => { le => '6/6/2020' }, # XXX: breaks in 2020! date_created => '5/10/2002 10:34:56 am' ], clauses => [ "LOWER(status) LIKE 'w%'" ], hints => { nicks => { force_index => 'rose_db_object_nicks_idx' }, t1 => { ignore_index => 'rose_db_object_test_idx' } }, sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() with many 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() with many 2 - $db_type"); ok(!defined $objs->[0]->{'status'}, "lazy main 1 - $db_type"); is($objs->[0]->status, 'with', "lazy main 2 - $db_type"); my $object = MyMySQLObject->new(id => $objs->[0]->id); $object->load(with => [ 'nicks.type' ]); is($object->{'status'}, undef, "lazy load(with) 1 - $db_type"); my $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many 3 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many 4 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many 5 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many 6 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many 7 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', share_db => 1, with_objects => [ 'bb2', 'nicks', 'bb1' ], query => [ 't1.id' => { ge => 1 }, 't1.name' => 'Betty', flag => 'f', flag2 => 1, bits => '10101', 't3.nick' => { like => 'n%' }, start => '5/20/2002', '!start' => { gt => DateTime->new(year => '2005', month => 12, day => 1) }, '!rose_db_object_test.start' => { gt => DateTime->new(year => '2005', month => 12, day => 2) }, '!t1.start' => { gt => DateTime->new(year => '2005', month => 12, day => 3) }, save_col => [ 1, 5, 123 ], nums => [ 4, 5, 6 ], fk1 => 1, last_modified => { le => '6/6/2020' }, # XXX: breaks in 2020! date_created => '5/10/2002 10:34:56 am' ], hints => { ignore_index => 'rose_db_object_test_idx' }, clauses => [ "LOWER(status) LIKE 'w%'" ], sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() with many 8 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() with many 9 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many 10 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many 11 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many 12 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many 13 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many 14 - $db_type"); $fo1 = $objs->[0]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects() with many bb1 1 - $db_type"); $fo1 = $objs->[0]->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects() with many bb2 2 - $db_type"); $iterator = MyMySQLObjectManager->get_objectz_iterator( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => [ 'nicks' ], sort_by => 't1.name'); is(ref $iterator, 'Rose::DB::Object::Iterator', "get_objects_iterator() 1 - $db_type"); $o = $iterator->next; is($o->name, 'Betty', "iterator many next() 1 - $db_type"); is($o->id, 5, "iterator many next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Bob', "iterator many next() 3 - $db_type"); is($o->id, 4, "iterator many next() 4 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "iterator many next() 5 - $db_type"); is($o->id, 2, "iterator many next() 6 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "iterator many sub-object 1 - $db_type"); is($o->{'nicks'}[0]{'nick'}, 'ntwo', "iterator many sub-object 2 - $db_type"); is($o->{'nicks'}[1]{'nick'}, 'nfour', "iterator many sub-object 3 - $db_type"); $o = $iterator->next; is($o->name, 'Sue', "iterator many next() 7 - $db_type"); is($o->id, 3, "iterator many next() 8 - $db_type"); $o = $iterator->next; is($o, 0, "iterator many next() 9 - $db_type"); is($iterator->total, 4, "iterator many total() - $db_type"); $iterator = MyMySQLObjectManager->get_objectz_iterator( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], sort_by => 't1.name', limit => 2); $o = $iterator->next; is($o->name, 'Betty', "iterator limit 2 many next() 1 - $db_type"); is($o->id, 5, "iterator limit 2 many next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Bob', "iterator limit 2 many next() 3 - $db_type"); is($o->id, 4, "iterator limit 2 many next() 4 - $db_type"); $o = $iterator->next; is($o, 0, "iterator limit 2 many next() 5 - $db_type"); is($iterator->total, 2, "iterator limit 2 many total() - $db_type"); $iterator = MyMySQLObjectManager->get_objectz_iterator( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => 1, sort_by => 't1.name', limit => 3); $o = $iterator->next; is($o->name, 'Betty', "iterator limit 3 many next() 1 - $db_type"); is($o->id, 5, "iterator limit 3 many next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Bob', "iterator limit 3 many next() 3 - $db_type"); is($o->id, 4, "iterator limit 3 many next() 4 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "iterator limit 3 many next() 5 - $db_type"); is($o->id, 2, "iterator limit 3 many next() 6 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "iterator limit 3 many sub-object 1 - $db_type"); is($o->{'nicks'}[0]{'nick'}, 'ntwo', "iterator limit 3 many sub-object 2 - $db_type"); is($o->{'nicks'}[1]{'nick'}, 'nfour', "iterator limit 3 many sub-object 3 - $db_type"); $o = $iterator->next; is($o, 0, "iterator limit 3 many next() 7 - $db_type"); is($iterator->total, 3, "iterator limit 3 many total() - $db_type"); $objs = MyMySQLObjectManager->get_objectz( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], sort_by => 't1.name', limit => 2); ok(ref $objs && @$objs == 2, "get_objects() limit 2 many 1 - $db_type"); is($objs->[0]->name, 'Betty', "get_objects() limit 2 many 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() limit 2 many 3 - $db_type"); is($objs->[1]->name, 'Bob', "get_objects() limit 2 many 4 - $db_type"); is($objs->[1]->id, 4, "get_objects() limit 2 many 5 - $db_type"); $objs = MyMySQLObjectManager->get_objectz( share_db => 1, with_objects => [ 'nicks', 'bb2' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => 1, sort_by => 't1.name', limit => 3); ok(ref $objs && @$objs == 3, "get_objects() limit 3 many 1 - $db_type"); is($objs->[0]->name, 'Betty', "get_objects() limit 3 many 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() limit 3 many 3 - $db_type"); is($objs->[1]->name, 'Bob', "get_objects() limit 3 many 4 - $db_type"); is($objs->[1]->id, 4, "get_objects() limit 3 many 5 - $db_type"); is($objs->[2]->name, 'Fred', "get_objects() limit 3 many 6 - $db_type"); is($objs->[2]->id, 2, "get_objects() limit 3 many 7 - $db_type"); is(scalar @{$objs->[2]->{'nicks'}}, 2, 'get_objects() limit 3 many sub-object 1'); is($objs->[2]->{'nicks'}[0]{'nick'}, 'ntwo', 'get_objects() limit 3 many sub-object 2'); is($objs->[2]->{'nicks'}[1]{'nick'}, 'nfour', 'get_objects() limit 3 many sub-object 3'); $iterator = MyMySQLObjectManager->get_objectz_iterator( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => 1, sort_by => 't1.name', limit => 2, offset => 1); $o = $iterator->next; is($o->name, 'Bob', "iterator limit 2 offset 1 many next() 1 - $db_type"); is($o->id, 4, "iterator limit 2 offset 1 many next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "iterator limit 2 offset 1 many next() 3 - $db_type"); is($o->id, 2, "iterator limit 2 offset 1 many next() 4 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, 'iterator limit 2 offset 1 many sub-object 1'); is($o->{'nicks'}[0]{'nick'}, 'ntwo', 'iterator limit 2 offset 1 many sub-object 2'); is($o->{'nicks'}[1]{'nick'}, 'nfour', 'iterator limit 2 offset 1 many sub-object 3'); $o = $iterator->next; is($o, 0, "iterator limit 2 offset 1 many next() 5 - $db_type"); is($iterator->total, 2, "iterator limit 2 offset 1 many total() - $db_type"); $iterator = MyMySQLObjectManager->get_objectz_iterator( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => 1, sort_by => 't1.name', limit => 3, offset => 2); $o = $iterator->next; is($o->name, 'Fred', "iterator limit 3 offset 2 many next() 1 - $db_type"); is($o->id, 2, "iterator limit 3 offset 2 many next() 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, 'iterator limit 3 offset 2 many sub-object 1'); is($o->{'nicks'}[0]{'nick'}, 'ntwo', 'iterator limit 3 offset 2 many sub-object 2'); is($o->{'nicks'}[1]{'nick'}, 'nfour', 'iterator limit 3 offset 2 many sub-object 3'); $o = $iterator->next; is($o->name, 'Sue', "iterator limit 3 offset 2 many next() 3 - $db_type"); is($o->id, 3, "iterator limit 3 offset 2 many next() 4 - $db_type"); $o = $iterator->next; is($o, 0, "iterator limit 3 offset 2 many next() 5 - $db_type"); is($iterator->total, 2, "iterator limit 3 offset 2 many total() - $db_type"); $objs = MyMySQLObjectManager->get_objectz( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => 1, sort_by => 't1.name', limit => 2, offset => 1); ok(ref $objs && @$objs == 2, "get_objects() limit 2 offset 1 many 1 - $db_type"); is($objs->[0]->name, 'Bob', "get_objects() limit 2 offset 1 many 2 - $db_type"); is($objs->[0]->id, 4, "get_objects() limit 2 offset 1 many 3 - $db_type"); is($objs->[1]->name, 'Fred', "get_objects() limit 2 offset 1 many 4 - $db_type"); is($objs->[1]->id, 2, "get_objects() limit 2 offset 1 many 5 - $db_type"); is(scalar @{$objs->[1]->{'nicks'}}, 2, 'get_objects() limit 2 offset 1 many sub-object 1'); is($objs->[1]->{'nicks'}[0]{'nick'}, 'ntwo', 'get_objects() limit 2 offset 1 many sub-object 2'); is($objs->[1]->{'nicks'}[1]{'nick'}, 'nfour', 'get_objects() limit 2 offset 1 many sub-object 3'); $objs = MyMySQLObjectManager->get_objectz( share_db => 1, with_objects => [ 'nicks', 'bb2' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => 1, sort_by => 't1.name', limit => 3, offset => 2); ok(ref $objs && @$objs == 2, "get_objects() limit 3 offset 2 many 1 - $db_type"); is($objs->[0]->name, 'Fred', "get_objects() limit 3 offset 2 many 2 - $db_type"); is($objs->[0]->id, 2, "get_objects() limit 3 offset 2 many 3 - $db_type"); is(scalar @{$objs->[0]->{'nicks'}}, 2, 'get_objects() limit 3 offset 2 many sub-object 1'); is($objs->[0]->{'nicks'}[0]{'nick'}, 'ntwo', 'get_objects() limit 3 offset 2 many sub-object 2'); is($objs->[0]->{'nicks'}[1]{'nick'}, 'nfour', 'get_objects() limit 3 offset 2 many sub-object 3'); is($objs->[1]->name, 'Sue', "get_objects() limit 3 offset 2 many 4 - $db_type"); is($objs->[1]->id, 3, "get_objects() limit 3 offset 2 many 5 - $db_type"); my $o6 = $o2->clone; $o6->id(60); $o6->fkone(undef); $o6->fk2(undef); $o6->fk3(undef); $o6->b1(undef); $o6->b2(2); $o6->name('Ted'); ok($o6->save, "object save() 8 - $db_type"); my $o7 = $o2->clone; $o7->id(70); $o7->b1(3); $o7->b2(undef); $o7->name('Joe'); ok($o7->save, "object save() 9 - $db_type"); my $o8 = $o2->clone; $o8->id(80); $o8->b1(undef); $o8->b2(undef); $o8->name('Pete'); ok($o8->save, "object save() 10 - $db_type"); ok($fo->save, "object save() 10 - $db_type"); $fo = MyMySQLNick->new(id => 7, o_id => 60, nick => 'nseven'); ok($fo->save, "nick object save() 7 - $db_type"); $fo = MyMySQLNick->new(id => 8, o_id => 60, nick => 'neight'); ok($fo->save, "nick object save() 8 - $db_type"); $fo = MyMySQLNick->new(id => 9, o_id => 60, nick => 'neight'); ok($fo->save, "nick object save() 8 - $db_type"); $fo = MyMySQLNick2->new(id => 1, o_id => 5, nick2 => 'n2one'); ok($fo->save, "nick2 object save() 1 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', share_db => 1, require_objects => [ 'bb2', 'bb1' ], query => [ '!t1.id' => 5 ], sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() with many 15 - $db_type"); $objs ||= []; is(scalar @$objs, 0, "get_objects() with many 16 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( object_class => 'MyMySQLObject', share_db => 1, require_objects => [ 'bb2', 'bb1' ], with_objects => [ 'nicks' ], query => [ ], sort_by => 't1.id'); is($count, 1, "get_objects_count() require 1 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; $count = Rose::DB::Object::Manager->get_objects_count( object_class => 'MyMySQLObject', share_db => 1, require_objects => [ 'bb2' ], with_objects => [ 'nicks' ], query => [ ], sort_by => 't1.id'); is($count, 2, "get_objects_count() require 2 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', share_db => 1, require_objects => [ 'bb2', 'bb1' ], with_objects => [ 'nicks' ], query => [ ], sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() with many 17 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() with many 18 - $db_type"); is($objs->[0]->id, 5, "get_objects() with many 19 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many 20 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many 21 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many 22 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many 23 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many 24 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', share_db => 1, require_objects => [ 'bb1', 'bb2' ], with_objects => [ 'nicks2', 'nicks' ], multi_many_ok => 1, query => [ ], sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() with multi many 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() with multi many 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() with multi many 3 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with multi many 4 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with multi many 5 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with multi many 6 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with multi many 7 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with multi many 8 - $db_type"); is($objs->[0]->{'nicks2'}[0]{'nick2'}, 'n2one', "get_objects() with multi many 9 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyMySQLObject', share_db => 1, require_objects => [ 'bb1', 'bb2' ], with_objects => [ 'nicks2', 'nicks' ], multi_many_ok => 1, query => [ ], sort_by => 't1.id'); $o = $iterator->next; is($o->name, 'Betty', "iterator with and require 1 - $db_type"); is($o->id, 5, "iterator with and require 2 - $db_type"); $nicks = $o->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "iterator with and require 3 - $db_type"); is($nicks->[0]->nick, 'nthree', "iterator with and require 4 - $db_type"); is($nicks->[1]->nick, 'nsix', "iterator with and require 5 - $db_type"); is($nicks->[2]->nick, 'none', "iterator with and require 6 - $db_type"); is($nicks->[3]->nick, 'nfive', "iterator with and require 7 - $db_type"); is($o->{'nicks2'}[0]{'nick2'}, 'n2one', "iterator with and require 8 - $db_type"); $o = $iterator->next; is($o, 0, "iterator with and require 9 - $db_type"); is($iterator->total, 1, "iterator with and require 10 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', share_db => 1, with_objects => [ 'bb2', 'nicks', 'bb1' ], query => [ ], sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() with many 25 - $db_type"); $objs ||= []; is(scalar @$objs, 8, "get_objects() with many 26 - $db_type"); my $ids = join(',', map { $_->id } @$objs); is($ids, '1,2,3,4,5,60,70,80', "get_objects() with many 27 - $db_type"); $nicks = $objs->[4]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many 28 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many 29 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many 30 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many 31 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many 32 - $db_type"); is($objs->[6]->{'bb1'}->{'name'}, 'three', "get_objects() with many 33 - $db_type"); ok(!defined $objs->[6]->{'bb2'}, "get_objects() with many 34 - $db_type"); ok(!defined $objs->[6]->{'nicks'}, "get_objects() with many 35 - $db_type"); ok(!defined $objs->[7]->{'bb1'}, "get_objects() with many 36 - $db_type"); ok(!defined $objs->[7]->{'bb1'}, "get_objects() with many 37 - $db_type"); ok(!defined $objs->[7]->{'nicks'}, "get_objects() with many 38 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 0; $fo = MyMySQLNick->new(id => 7); ok($fo->delete, "with many clean-up 1 - $db_type"); $fo = MyMySQLNick->new(id => 8); ok($fo->delete, "with many clean-up 2 - $db_type"); $fo = MyMySQLNick->new(id => 9); ok($fo->delete, "with many clean-up 3 - $db_type"); ok($o6->delete, "with many clean-up 4 - $db_type"); ok($o7->delete, "with many clean-up 5 - $db_type"); ok($o8->delete, "with many clean-up 6 - $db_type"); $fo = MyMySQLNick2->new(id => 1); ok($fo->delete, "with many clean-up 7 - $db_type"); # End "one to many" tests $iterator = MyMySQLObjectManager->get_objectz_iterator( share_db => 1, query => [ 't1.id' => { ge => 2 }, 't1.name' => { like => '%tt%' }, ], require_objects => [ 'other_obj', 'bb1', 'bb2' ]); $o = $iterator->next; ok(ref $o->{'other_obj'} eq 'MyMySQLOtherObject', "foreign object 4 - $db_type"); is($o->other_obj->k2, 2, "foreign object 5 - $db_type"); is($o->bb1->name, 'two', "bb foreign object 5 - $db_type"); is($o->bb2->name, 'four', "bb foreign object 6 - $db_type"); $objs = MyMySQLObjectManager->get_objectz( share_db => 1, query => [ id => { ge => 1 }, name => 'John', flag => 1, flag2 => 0, status => 'active', bits => '1', start => '1/2/2001', '!start' => { gt => DateTime->new(year => '2005', month => 1, day => 1) }, '!rose_db_object_test.start' => { gt => DateTime->new(year => '2005', month => 2, day => 2) }, '!t1.start' => { gt => DateTime->new(year => '2005', month => 3, day => 3) }, save_col => [ 1, 5 ], nums => [ 1, 2, 3 ], fk1 => 2, last_modified => { le => '6/6/2020' }, # XXX: breaks in 2020! date_created => '3/30/2004 12:34:56 pm' ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() 7 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() 8 - $db_type"); $objs = MyMySQLObject->get_objectz( share_db => 1, query => [ id => { ge => 2 }, k1 => { lt => 900 }, or => [ k1 => { ne => 99 }, k1 => 100 ], or => [ and => [ id => { ne => 123 }, id => { lt => 100 } ], and => [ id => { ne => 456 }, id => { lt => 300 } ] ], '!k2' => { gt => 999 }, '!t2.name' => 'z', start => { lt => DateTime->new(year => '2005', month => 1, day => 1) }, '!start' => { gt => DateTime->new(year => '2005', month => 1, day => 1) }, 'rose_db_object_test.name' => { like => '%tt%' }, '!rose_db_object_other.name' => 'q', '!rose_db_object_other.name' => [ 'x', 'y' ], ], require_objects => [ 'other_obj' ]); ok(ref $objs->[0]->{'other_obj'} eq 'MyMySQLOtherObject', "foreign object 6 - $db_type"); is($objs->[0]->other_obj->k2, 2, "foreign object 7 - $db_type"); # Test limit with offset foreach my $id (6 .. 20) { my $o = $o5->clone; $o->id($id); $o->name("Clone $id"); ok($o->save, "object save() clone $id - $db_type"); } $objs = MyMySQLObjectManager->get_objectz( sort_by => 'id DESC', limit => 2, offset => 8); ok(ref $objs eq 'ARRAY' && @$objs == 2 && $objs->[0]->id == 12 && $objs->[1]->id == 11, "get_objects() with offset - $db_type"); $objs = MyMySQLObject->get_objectz( sort_by => 'id DESC', require_objects => [ 'other_obj' ], limit => 2, offset => 8); ok(ref $objs eq 'ARRAY' && @$objs == 2 && $objs->[0]->id == 12 && $objs->[1]->id == 11, "get_objects() with objects and offset - $db_type"); $iterator = MyMySQLObject->get_objectz_iterator( sort_by => 'id DESC', limit => 2, offset => 8); $o = $iterator->next; is($o->id, 12, "get_objects_iterator() with offset 1 - $db_type"); $o = $iterator->next; is($o->id, 11, "get_objects_iterator() with offset 2 - $db_type"); is($iterator->next, 0, "get_objects_iterator() with offset 3 - $db_type"); eval { $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', sort_by => 'id DESC', offset => 8) }; ok($@ =~ /invalid without a limit/, "get_objects() missing offset - $db_type"); eval { $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyMySQLObject', sort_by => 'id DESC', offset => 8); }; ok($@ =~ /invalid without a limit/, "get_objects_iterator() missing offset - $db_type"); # Start *_sql comparison tests $o6->fk2(99); $o6->fk3(99); $o6->save; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', query => [ 'fk2' => { eq_sql => 'fk3' } ], sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq_sql 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() eq_sql 2 - $db_type"); is($objs->[0]->id, 60, "get_objects() eq_sql 3 - $db_type"); # End *_sql comparison tests # Start IN NULL tests #local $Rose::DB::Object::Manager::Debug = 1; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', query => [ id => [ undef, 60 ], '!id' => \'id + 1' ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() in null 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() in null 2 - $db_type"); is($objs->[0]->id, 60, "get_objects() in null 3 - $db_type"); # End IN NULL tests # Start scalar ref tests #local $Rose::DB::Object::Manager::Debug = 1; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', query => [ 'fk2' => \'fk3' ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq ref 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() eq ref 2 - $db_type"); is($objs->[0]->id, 60, "get_objects() eq ref 3 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', query => [ 'fk2' => [ \'fk3' ] ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq ref 4 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() eq ref 5 - $db_type"); is($objs->[0]->id, 60, "get_objects() eq ref 6 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', query => [ 'fk2' => { ne => \'fk3' } ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq ref 7 - $db_type"); $objs ||= []; is(scalar @$objs, 16, "get_objects() eq ref 8 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', query => [ 'fk2' => { ne => [ \'fk3' ] } ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq ref 9 - $db_type"); $objs ||= []; is(scalar @$objs, 16, "get_objects() eq ref 10 - $db_type"); # End scalar ref tests # Start "many to many" tests $fo = MyMySQLColor->new(id => 1, name => 'Red'); $fo->save; $fo = MyMySQLColor->new(id => 2, name => 'Green'); $fo->save; $fo = MyMySQLColor->new(id => 3, name => 'Blue'); $fo->save; $fo = MyMySQLColorMap->new(id => 1, object_id => $o2->id, color_id => 1); $fo->save; $fo = MyMySQLColorMap->new(id => 2, object_id => $o2->id, color_id => 3); $fo->save; $o2->b1(4); $o2->b1(2); $o2->fkone(2); $o2->fk2(3); $o2->fk3(4); $o2->save; my @colors = $o2->colors; ok(@colors == 2 && $colors[0]->name eq 'Red' && $colors[1]->name eq 'Blue', "Fetch many to many 1 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', share_db => 1, with_objects => [ 'other_obj', 'bb2', 'nicks', 'bb1', 'colors' ], multi_many_ok => 1, with_map_records => 1, query => [ id => [ 1, 2, 5 ] ], sort_by => 't1.name'); is(ref $objs, 'ARRAY', "get_objects() with many to many 1 - $db_type"); $objs ||= []; is(scalar @$objs, 3, "get_objects() with many to many 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() with many to many 3 - $db_type"); is($objs->[1]->id, 2, "get_objects() with many to many 4 - $db_type"); is($objs->[2]->id, 1, "get_objects() with many to many 5 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many to many 6 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many to many 7 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many to many 8 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many to many 9 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many to many 10 - $db_type"); $fo1 = $objs->[0]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects() with many to many 11 - $db_type"); $fo1 = $objs->[0]->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects() with many to many 12 - $db_type"); my $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() with many to many 13 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() with many to many 14 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects() with many to many 15 - $db_type"); is($colors->[0]->map_record->color_id, $colors->[0]->id, "map_record 1 - $db_type"); is($colors->[0]->map_record->object_id, $objs->[1]->id, "map_record 2 - $db_type"); is($colors->[1]->map_record->color_id, $colors->[1]->id, "map_record 3 - $db_type"); is($colors->[0]->map_record->object_id, $objs->[1]->id, "map_record 4 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyMySQLObject', share_db => 1, with_objects => [ 'other_obj', 'bb2', 'nicks', 'bb1', 'colors' ], multi_many_ok => 1, with_map_records => 'map_record', query => [ id => [ 1, 2, 5 ] ], sort_by => 't1.name'); $objs = []; while(my $obj = $iterator->next) { push(@$objs, $obj); } is(ref $objs, 'ARRAY', "get_objects_iterator() with many to many map record 1 - $db_type"); is(scalar @$objs, 3, "get_objects_iterator() with many to many map record 2 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db is($colors->[0]->map_record->color_id, $colors->[0]->id, "map_record 5 - $db_type"); is($colors->[0]->map_record->object_id, $objs->[1]->id, "map_record 6 - $db_type"); is($colors->[1]->map_record->color_id, $colors->[1]->id, "map_record 7 - $db_type"); is($colors->[0]->map_record->object_id, $objs->[1]->id, "map_record 8 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', share_db => 1, with_objects => [ 'other_obj', 'bb2', 'nicks', 'bb1', 'colors' ], multi_many_ok => 1, with_map_records => 'map_rec', query => [ id => [ 1, 2, 5 ] ], sort_by => 't1.name'); is(ref $objs, 'ARRAY', "get_objects() with many to many 1 - $db_type"); $objs ||= []; is(scalar @$objs, 3, "get_objects() with many to many 2 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db is($colors->[0]->map_rec->color_id, $colors->[0]->id, "map_rec 1 - $db_type"); is($colors->[0]->map_rec->object_id, $objs->[1]->id, "map_rec 2 - $db_type"); is($colors->[1]->map_rec->color_id, $colors->[1]->id, "map_rec 3 - $db_type"); is($colors->[0]->map_rec->object_id, $objs->[1]->id, "map_rec 4 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', share_db => 1, with_objects => [ 'bb1', 'nicks', 'other_obj', 'colors', 'bb2' ], multi_many_ok => 1, query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); is(ref $objs, 'ARRAY', "get_objects() with many to many (reorder) 1 - $db_type"); $objs ||= []; is(scalar @$objs, 3, "get_objects() with many to many (reorder) 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() with many to many (reorder) 3 - $db_type"); is($objs->[1]->id, 2, "get_objects() with many to many (reorder) 4 - $db_type"); is($objs->[2]->id, 1, "get_objects() with many to many (reorder) 5 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many to many (reorder) 6 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many to many (reorder) 7 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many to many (reorder) 8 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many to many (reorder) 9 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many to many (reorder) 10 - $db_type"); $fo1 = $objs->[0]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects() with many to many (reorder) 11 - $db_type"); $fo1 = $objs->[0]->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects() with many to many (reorder) 12 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() with many to many (reorder) 13 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() with many to many (reorder) 14 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects() with many to many (reorder) 15 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', share_db => 1, with_objects => [ 'nicks', 'colors', 'bb2' ], multi_many_ok => 1, require_objects => [ 'bb1', 'other_obj' ], query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); is(ref $objs, 'ARRAY', "get_objects() with many to many require with 1 - $db_type"); $objs ||= []; is(scalar @$objs, 2, "get_objects() with many to many require with 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() with many to many require with 3 - $db_type"); is($objs->[1]->id, 2, "get_objects() with many to many require with 4 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many to many require with 6 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many to many 7 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many to many 8 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many to many 9 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many to many 10 - $db_type"); $fo1 = $objs->[0]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects() with many to many require with 11 - $db_type"); $fo1 = $objs->[0]->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects() with many to many require with 12 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() with many to many require with 13 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() with many to many require with 14 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects() with many to many require with 15 - $db_type"); $fo1 = $objs->[1]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'two', "get_objects() with many to many require with 16 - $db_type"); $fo1 = $objs->[0]->{'other_obj'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'Foo 1', "get_objects() with many to many require with 17 - $db_type"); $fo1 = $objs->[1]->{'other_obj'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'Foo 2', "get_objects() with many to many require with 18 - $db_type"); ok(!defined $objs->[0]->{'colors'}, "get_objects() with many to many require with 19 - $db_type"); ok(!defined $objs->[1]->{'bb2'}, "get_objects() with many to many require with 20 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyMySQLObject', share_db => 1, with_objects => [ 'other_obj', 'bb2', 'nicks', 'bb1', 'colors' ], multi_many_ok => 1, query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); $o = $iterator->next; is($o->name, 'Betty', "get_objects_iterator() with many to many 1 - $db_type"); is($o->id, 5, "get_objects_iterator() with many to many 2 - $db_type"); $nicks = $o->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects_iterator() with many to many 3 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects_iterator() with many to many 4 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects_iterator() with many to many 5 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects_iterator() with many to many 6 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects_iterator() with many to many 7 - $db_type"); $fo1 = $o->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects_iterator() with many to many 8 - $db_type"); $fo1 = $o->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects_iterator() with many to many 9 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "get_objects_iterator() with many to many 10 - $db_type"); is($o->id, 2, "get_objects_iterator() with many to many 11 - $db_type"); $colors = $o->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects_iterator() with many to many 12 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many 13 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many 14 - $db_type"); $o = $iterator->next; is($o->name, 'John', "get_objects_iterator() with many to many 15 - $db_type"); is($o->id, 1, "get_objects_iterator() with many to many 16 - $db_type"); $o = $iterator->next; is($o, 0, "get_objects_iterator() with many to many 17 - $db_type"); is($iterator->total, 3, "get_objects_iterator() with many to many 18 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyMySQLObject', share_db => 1, with_objects => [ 'bb1', 'nicks', 'other_obj', 'colors', 'bb2' ], multi_many_ok => 1, query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); $o = $iterator->next; is($o->name, 'Betty', "get_objects_iterator() with many to many 19 - $db_type"); is($o->id, 5, "get_objects_iterator() with many to many 20 - $db_type"); $nicks = $o->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects_iterator() with many to many 21 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects_iterator() with many to many 22 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects_iterator() with many to many 23 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects_iterator() with many to many 24 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects_iterator() with many to many 25 - $db_type"); $fo1 = $o->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects_iterator() with many to many 26 - $db_type"); $fo1 = $o->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects_iterator() with many to many 27 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "get_objects_iterator() with many to many 28 - $db_type"); is($o->id, 2, "get_objects_iterator() with many to many 29 - $db_type"); $colors = $o->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects_iterator() with many to many 30 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many 31 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many 32 - $db_type"); $o = $iterator->next; is($o->name, 'John', "get_objects_iterator() with many to many 33 - $db_type"); is($o->id, 1, "get_objects_iterator() with many to many 34 - $db_type"); $o = $iterator->next; is($o, 0, "get_objects_iterator() with many to many 35 - $db_type"); is($iterator->total, 3, "get_objects_iterator() with many to many 36 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyMySQLObject', share_db => 1, with_objects => [ 'nicks', 'colors', 'bb2' ], multi_many_ok => 1, require_objects => [ 'bb1', 'other_obj' ], query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); $o = $iterator->next; is($o->name, 'Betty', "get_objects_iterator() with many to many require 1 - $db_type"); is($o->id, 5, "get_objects_iterator() with many to many require 2 - $db_type"); $fo1 = $o->{'other_obj'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'Foo 1', "get_objects_iterator() with many to many require 3 - $db_type"); ok(!defined $o->{'colors'}, "get_objects_iterator() with many to many require 4 - $db_type"); $nicks = $o->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects_iterator() with many to many require 5 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects_iterator() with many to many require 6 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects_iterator() with many to many require 7 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects_iterator() with many to many require 8 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects_iterator() with many to many require 9 - $db_type"); $fo1 = $o->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects_iterator() with many to many require 10 - $db_type"); $fo1 = $o->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects_iterator() with many to many require 11 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "get_objects_iterator() with many to many require 12 - $db_type"); is($o->id, 2, "get_objects_iterator() with many to many require 13 - $db_type"); $colors = $o->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects_iterator() with many to many require 14 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many require 15 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many require 16 - $db_type"); $fo1 = $o->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'two', "get_objects_iterator() with many to many require 17 - $db_type"); $fo1 = $o->{'other_obj'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'Foo 2', "get_objects_iterator() with many to many require 18 - $db_type"); ok(!defined $o->{'bb2'}, "get_objects_iterator() with many to many require 19 - $db_type"); $o = $iterator->next; is($o, 0, "get_objects_iterator() with many to many require 20 - $db_type"); is($iterator->total, 2, "get_objects_iterator() with many to many require 21 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyMySQLObject', share_db => 1, with_objects => [ 'nicks', 'colors', 'bb2' ], multi_many_ok => 1, require_objects => [ 'bb1', 'other_obj' ], query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name', limit => 1, offset => 5); ok(!$iterator->next, "get_objects_iterator() with many to many require 22 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', share_db => 1, with_objects => [ 'nicks', 'colors', 'bb2' ], multi_many_ok => 1, require_objects => [ 'bb1', 'other_obj' ], query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name', limit => 1, offset => 5); ok(@$objs == 0, "get_objects_iterator() with many to many require 23 - $db_type"); # End "many to many" tests # Start multi-require tests $fo = MyMySQLColorMap->new(id => 3, object_id => 5, color_id => 2); $fo->save; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', share_db => 1, require_objects => [ 'nicks', 'colors', 'other_obj' ], multi_many_ok => 1, sort_by => 't1.name'); is(scalar @$objs, 2, "get_objects() multi many require 1 - $db_type"); is($objs->[0]->id, 5, "get_objects() multi many require 2 - $db_type"); is($objs->[1]->id, 2, "get_objects() multi many require 3 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() multi many require 4 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() multi many require 5 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() multi many require 6 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() multi many require 7 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() multi many require 8 - $db_type"); $colors = $objs->[0]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 1, "get_objects() multi many require 9 - $db_type"); ok($colors->[0]->id == 2 && $colors->[0]->name eq 'Green', "get_objects() multi many require 10 - $db_type"); $nicks = $objs->[1]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 2, "get_objects() multi many require 11 - $db_type"); is($nicks->[0]->nick, 'ntwo', "get_objects() multi many require 12 - $db_type"); is($nicks->[1]->nick, 'nfour', "get_objects() multi many require 13 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() multi many require 14 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() multi many require 15 - $db_type"); ok($colors->[1]->id == 3 && $colors->[1]->name eq 'Blue', "get_objects() multi many require 16 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', share_db => 1, require_objects => [ 'nicks', 'colors', 'other_obj' ], with_objects => [ 'bb2' ], multi_many_ok => 1, sort_by => 't1.name'); is(scalar @$objs, 2, "get_objects() multi many with require 1 - $db_type"); is($objs->[0]->id, 5, "get_objects() multi many with require 2 - $db_type"); is($objs->[1]->id, 2, "get_objects() multi many with require 3 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() multi many with require 4 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() multi many with require 5 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() multi many with require 6 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() multi many with require 7 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() multi many with require 8 - $db_type"); $colors = $objs->[0]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 1, "get_objects() multi many with require 9 - $db_type"); ok($colors->[0]->id == 2 && $colors->[0]->name eq 'Green', "get_objects() multi many with require 10 - $db_type"); $nicks = $objs->[1]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 2, "get_objects() multi many with require 11 - $db_type"); is($nicks->[0]->nick, 'ntwo', "get_objects() multi many with require 12 - $db_type"); is($nicks->[1]->nick, 'nfour', "get_objects() multi many with require 13 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() multi many with require 14 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() multi many with require 15 - $db_type"); ok($colors->[1]->id == 3 && $colors->[1]->name eq 'Blue', "get_objects() multi many with require 16 - $db_type"); is($objs->[0]->{'bb2'}{'name'}, 'four', "get_objects() multi many with require 17 - $db_type"); ok(!defined $objs->[1]->{'bb2'}{'name'}, "get_objects() multi many with require 18 - $db_type"); MyMySQLNick->new(id => 7, o_id => 10, nick => 'nseven')->save; MyMySQLNick->new(id => 8, o_id => 11, nick => 'neight')->save; MyMySQLNick->new(id => 9, o_id => 12, nick => 'nnine')->save; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', share_db => 1, require_objects => [ 'nicks', 'bb1' ], with_objects => [ 'colors' ], multi_many_ok => 1, sort_by => 't1.name'); is(scalar @$objs, 5, "get_objects() multi many with require map 1 - $db_type"); is($objs->[0]->id, 5, "get_objects() multi many with require map 2 - $db_type"); is($objs->[1]->id, 10, "get_objects() multi many with require map 3 - $db_type"); is($objs->[2]->id, 11, "get_objects() multi many with require map 4 - $db_type"); is($objs->[3]->id, 12, "get_objects() multi many with require map 5 - $db_type"); is($objs->[4]->id, 2, "get_objects() multi many with require map 6 - $db_type"); # End multi-require tests # Start distinct tests my $i = 0; foreach my $distinct (1, [ 't1' ], [ 'rose_db_object_test' ]) { $i++; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', distinct => $distinct, share_db => 1, require_objects => [ 'nicks', 'colors', 'other_obj' ], multi_many_ok => 1, sort_by => 't1.name'); is(scalar @$objs, 2, "get_objects() distinct multi many require $i.1 - $db_type"); is($objs->[0]->id, 5, "get_objects() distinct multi many require $i.2 - $db_type"); is($objs->[1]->id, 2, "get_objects() distinct multi many require $i.3 - $db_type"); ok(!defined $objs->[0]->{'nicks'}, "get_objects() distinct multi many require $i.4 - $db_type"); ok(!defined $objs->[0]->{'colors'}, "get_objects() distinct multi many require $i.5 - $db_type"); ok(!defined $objs->[1]->{'nicks'}, "get_objects() distinct multi many require $i.6 - $db_type"); ok(!defined $objs->[1]->{'colors'}, "get_objects() distinct multi many require $i.7 - $db_type"); } #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; foreach my $distinct ([ 't2' ], [ 'rose_db_object_nicks' ], [ 'nicks' ]) { $i++; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', distinct => $distinct, share_db => 1, require_objects => [ 'nicks', 'colors', 'other_obj' ], multi_many_ok => 1, sort_by => 't1.name'); is(scalar @$objs, 2, "get_objects() distinct multi many require $i.1 - $db_type"); is($objs->[0]->id, 5, "get_objects() distinct multi many require $i.2 - $db_type"); is($objs->[1]->id, 2, "get_objects() distinct multi many require $i.3 - $db_type"); ok(defined $objs->[0]->{'nicks'}, "get_objects() distinct multi many require $i.4 - $db_type"); ok(!defined $objs->[0]->{'colors'}, "get_objects() distinct multi many require $i.5 - $db_type"); ok(defined $objs->[1]->{'nicks'}, "get_objects() distinct multi many require $i.6 - $db_type"); ok(!defined $objs->[1]->{'colors'}, "get_objects() distinct multi many require $i.7 - $db_type"); } # End distinct tests # Start pager tests is(Rose::DB::Object::Manager->default_objects_per_page, 20, 'default_objects_per_page 1'); Rose::DB::Object::Manager->default_objects_per_page(3); my $per_page = Rose::DB::Object::Manager->default_objects_per_page; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 1, per_page => 3); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 1.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 1); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 2.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', query => [ id => { le => 11 } ], sort_by => 't1.id', per_page => 3); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 3.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', query => [ id => { le => 11 } ], sort_by => 't1.id', per_page => -1); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 4.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => -1); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 5.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => undef); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 6.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', query => [ id => { le => 11 } ], sort_by => 't1.id', per_page => undef); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 7.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', query => [ id => { le => 11 } ], sort_by => 't1.id'); ok(scalar @$objs > 3, "pager 8 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 2, per_page => 3); $i = 0; for(4 .. 6) { is($objs->[$i++]->id, $_, "pager 9.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 3, per_page => 3); $i = 0; for(7 .. 9) { is($objs->[$i++]->id, $_, "pager 10.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 4, per_page => 3); $i = 0; for(10 .. 11) { is($objs->[$i++]->id, $_, "pager 11.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 5, per_page => 3); ok(scalar @$objs == 0, "pager 12 - $db_type"); Rose::DB::Object::Manager->default_objects_per_page(20); # End pager tests # Start get_objects_from_sql tests $objs = MyMySQLObjectManager->get_objects_from_sql( db => MyMySQLObject->init_db, object_class => 'MyMySQLObject', prepare_cached => 1, sql => <<"EOF"); SELECT * FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF ok(scalar @$objs == 19, "get_objects_from_sql 1 - $db_type"); is($objs->[18]->id, 1, "get_objects_from_sql 2 - $db_type"); is($objs->[18]->save_col, 5, "get_objects_from_sql 3 - $db_type"); is($objs->[18]->name, 'John', "get_objects_from_sql 4 - $db_type"); $iterator = MyMySQLObjectManager->get_objects_iterator_from_sql( db => MyMySQLObject->init_db, object_class => 'MyMySQLObject', prepare_cached => 1, sql => <<"EOF"); SELECT * FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF for(0 .. 17) { $iterator->next } $o = $iterator->next; is($o->id, 1, "get_objects_iterator_from_sql 1 - $db_type"); is($o->save_col, 5, "get_objects_iterator_from_sql 2 - $db_type"); is($o->name, 'John', "get_objects_iterator_from_sql 3 - $db_type"); ok(!$iterator->next, "get_objects_iterator_from_sql 4 - $db_type"); $objs = MyMySQLObjectManager->get_objects_from_sql(<<"EOF"); SELECT * FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF ok(scalar @$objs == 19, "get_objects_from_sql 5 - $db_type"); is($objs->[18]->id, 1, "get_objects_from_sql 6 - $db_type"); is($objs->[18]->save_col, 5, "get_objects_from_sql 7 - $db_type"); is($objs->[18]->name, 'John', "get_objects_from_sql 8 - $db_type"); $objs = MyMySQLObjectManager->get_objects_from_sql( args => [ 19 ], sql => <<"EOF"); SELECT * FROM rose_db_object_test WHERE id > ? ORDER BY id DESC EOF ok(scalar @$objs == 2, "get_objects_from_sql 9 - $db_type"); is($objs->[0]->id, 60, "get_objects_from_sql 10 - $db_type"); my $method = MyMySQLObjectManager->make_manager_method_from_sql( get_em => <<"EOF"); SELECT *, save + fk1 AS extra FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF $objs = MyMySQLObjectManager->get_em; ok(scalar @$objs == 19, "make_manager_method_from_sql 1 - $db_type"); is($objs->[17]->id, 3, "make_manager_method_from_sql 2 - $db_type"); is($objs->[17]->extra, 7, "make_manager_method_from_sql 3 - $db_type"); is($objs->[17]->name, 'Sue', "make_manager_method_from_sql 4 - $db_type"); $objs = $method->('MyMySQLObjectManager'); ok(scalar @$objs == 19, "make_manager_method_from_sql 5 - $db_type"); is($objs->[17]->id, 3, "make_manager_method_from_sql 6 - $db_type"); is($objs->[17]->extra, 7, "make_manager_method_from_sql 7 - $db_type"); is($objs->[17]->name, 'Sue', "make_manager_method_from_sql 8 - $db_type"); $method = MyMySQLObjectManager->make_manager_method_from_sql( iterator => 1, method => 'iter_em', sql => <<"EOF"); SELECT *, save + fk1 AS extra FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF $iterator = MyMySQLObjectManager->iter_em; for(0 .. 16) { $iterator->next } $o = $iterator->next; is($objs->[17]->id, 3, "make_manager_method_from_sql iterator 1 - $db_type"); is($objs->[17]->extra, 7, "make_manager_method_from_sql iterator 2 - $db_type"); is($objs->[17]->name, 'Sue', "make_manager_method_from_sql iterator 3 - $db_type"); $iterator = $method->('MyMySQLObjectManager'); for(0 .. 16) { $iterator->next } $o = $iterator->next; is($objs->[17]->id, 3, "make_manager_method_from_sql iterator 4 - $db_type"); is($objs->[17]->extra, 7, "make_manager_method_from_sql iterator 5 - $db_type"); is($objs->[17]->name, 'Sue', "make_manager_method_from_sql iterator 6 - $db_type"); $method = MyMySQLObjectManager->make_manager_method_from_sql( get_more => <<"EOF"); SELECT *, save + fk1 AS extra FROM rose_db_object_test WHERE id > ? ORDER BY id DESC EOF $objs = MyMySQLObjectManager->get_more(18); ok(scalar @$objs == 3, "make_manager_method_from_sql 9 - $db_type"); is($objs->[2]->id, 19, "make_manager_method_from_sql 10 - $db_type"); $method = MyMySQLObjectManager->make_manager_method_from_sql( method => 'get_more_np', params => [ qw(id name) ], sql => <<"EOF"); SELECT *, save + fk1 AS extra FROM rose_db_object_test WHERE id > ? AND name != ? ORDER BY id DESC EOF $objs = MyMySQLObjectManager->get_more_np(name => 'Nonesuch', id => 18); ok(scalar @$objs == 3, "make_manager_method_from_sql 11 - $db_type"); is($objs->[2]->id, 19, "make_manager_method_from_sql 12 - $db_type"); # End get_objects_from_sql tests # Start tough order tests $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', require_objects => [ 'nicks' ], nonlazy => 1); ok(@$objs == 5, "tough order 1 - $db_type"); is($objs->[0]->id, 2, "tough order 2 - $db_type"); is($objs->[1]->id, 5, "tough order 3 - $db_type"); is($objs->[2]->id, 10, "tough order 4 - $db_type"); is($objs->[3]->id, 11, "tough order 5 - $db_type"); is($objs->[4]->id, 12, "tough order 6 - $db_type"); is($objs->[0]{'nicks'}[0]{'nick'}, 'ntwo', "tough order 7 - $db_type"); is($objs->[0]{'nicks'}[1]{'nick'}, 'nfour', "tough order 8 - $db_type"); is($objs->[1]{'nicks'}[0]{'nick'}, 'nthree', "tough order 9 - $db_type"); is($objs->[1]{'nicks'}[1]{'nick'}, 'nsix', "tough order 10 - $db_type"); is($objs->[1]{'nicks'}[2]{'nick'}, 'none', "tough order 11 - $db_type"); is($objs->[1]{'nicks'}[3]{'nick'}, 'nfive', "tough order 12 - $db_type"); is($objs->[2]{'nicks'}[0]{'nick'}, 'nseven', "tough order 13 - $db_type"); is($objs->[3]{'nicks'}[0]{'nick'}, 'neight', "tough order 14 - $db_type"); is($objs->[4]{'nicks'}[0]{'nick'}, 'nnine', "tough order 15 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', require_objects => [ 'nicks' ], nonlazy => 1, sort_by => 'name'); ok(@$objs == 5, "tough order 16 - $db_type"); is($objs->[0]->id, 5, "tough order 17 - $db_type"); is($objs->[1]->id, 10, "tough order 18 - $db_type"); is($objs->[2]->id, 11, "tough order 19 - $db_type"); is($objs->[3]->id, 12, "tough order 20 - $db_type"); is($objs->[4]->id, 2, "tough order 21 - $db_type"); is($objs->[0]{'nicks'}[0]{'nick'}, 'nthree', "tough order 22 - $db_type"); is($objs->[0]{'nicks'}[1]{'nick'}, 'nsix', "tough order 23 - $db_type"); is($objs->[0]{'nicks'}[2]{'nick'}, 'none', "tough order 24 - $db_type"); is($objs->[0]{'nicks'}[3]{'nick'}, 'nfive', "tough order 25 - $db_type"); is(scalar @{$objs->[0]{'nicks'}}, 4, "tough order 26 - $db_type"); is($objs->[1]{'nicks'}[0]{'nick'}, 'nseven', "tough order 27 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 1, "tough order 28 - $db_type"); is($objs->[2]{'nicks'}[0]{'nick'}, 'neight', "tough order 29 - $db_type"); is(scalar @{$objs->[2]{'nicks'}}, 1, "tough order 30 - $db_type"); is($objs->[3]{'nicks'}[0]{'nick'}, 'nnine', "tough order 31 - $db_type"); is(scalar @{$objs->[3]{'nicks'}}, 1, "tough order 32 - $db_type"); is($objs->[4]{'nicks'}[0]{'nick'}, 'ntwo', "tough order 33 - $db_type"); is($objs->[4]{'nicks'}[1]{'nick'}, 'nfour', "tough order 34 - $db_type"); is(scalar @{$objs->[4]{'nicks'}}, 2, "tough order 35 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyMySQLObject', require_objects => [ 'nicks' ], nonlazy => 1, sort_by => 'name'); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'nthree', "tough order 36 - $db_type"); is($o->{'nicks'}[1]{'nick'}, 'nsix', "tough order 37 - $db_type"); is($o->{'nicks'}[2]{'nick'}, 'none', "tough order 38 - $db_type"); is($o->{'nicks'}[3]{'nick'}, 'nfive', "tough order 39 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "tough order 40 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'nseven', "tough order 41 - $db_type"); is(scalar @{$o->{'nicks'}}, 1, "tough order 42 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'neight', "tough order 43 - $db_type"); is(scalar @{$o->{'nicks'}}, 1, "tough order 44 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'nnine', "tough order 45 - $db_type"); is(scalar @{$o->{'nicks'}}, 1, "tough order 46 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'ntwo', "tough order 47 - $db_type"); is($o->{'nicks'}[1]{'nick'}, 'nfour', "tough order 48 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "tough order 49 - $db_type"); ok(!$iterator->next, "tough order 50 - $db_type"); is($iterator->total, 5, "tough order 51 - $db_type"); # End tough order tests # Start deep join tests eval { Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', require_objects => [ 'nicks.type' ], with_objects => [ 'nicks.type' ]); }; ok($@, "deep join conflict 1 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', require_objects => [ 'nicks.type', 'nicks.type', 'nicks' ], with_objects => [ 'nicks.type.t2', 'nicks.alts' ], multi_many_ok => 1, nonlazy => 1, query => [ 'id' => [ 2, 5 ] ], sort_by => 'type.name'); ok(@$objs == 2, "deep join 1 - $db_type"); is($objs->[0]->id, 2, "deep join 2 - $db_type"); is($objs->[1]->id, 5, "deep join 3 - $db_type"); #SORT: #{ # $objs->[0]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[0]{'nicks'}} ]; #} is($objs->[0]{'nicks'}[0]{'type'}{'name'}, 'nt four', "deep join 4 - $db_type"); is($objs->[0]{'nicks'}[1]{'type'}{'name'}, 'nt two', "deep join 5 - $db_type"); is(scalar @{$objs->[0]{'nicks'}}, 2, "deep join 6 - $db_type"); #SORT: #{ # $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; #} is($objs->[1]{'nicks'}[0]{'type'}{'name'}, 'nt five', "deep join 7 - $db_type"); is($objs->[1]{'nicks'}[1]{'type'}{'name'}, 'nt one', "deep join 8 - $db_type"); is($objs->[1]{'nicks'}[2]{'type'}{'name'}, 'nt six', "deep join 9 - $db_type"); is($objs->[1]{'nicks'}[3]{'type'}{'name'}, 'nt three', "deep join 10 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 4, "deep join 11 - $db_type"); is($objs->[0]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join 12 - $db_type"); is($objs->[0]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join 13 - $db_type"); is($objs->[0]{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt two 1', "deep join 14 - $db_type"); $objs->[1]{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$objs->[1]{'nicks'}[1]{'alts'}} ]; is($objs->[1]{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt one 1', "deep join 15 - $db_type"); is($objs->[1]{'nicks'}[1]{'alts'}[1]{'alt'}, 'alt one 2', "deep join 16 - $db_type"); is($objs->[1]{'nicks'}[1]{'alts'}[2]{'alt'}, 'alt one 3', "deep join 17 - $db_type"); is(scalar @{$objs->[1]{'nicks'}[1]{'alts'}}, 3, "deep join 18 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', with_objects => [ 'nicks.type' ], nonlazy => 1, sort_by => 'type.name'); ok(@$objs == 21, "deep join with 1 - $db_type"); is($objs->[0]->id, 1, "deep join with 2 - $db_type"); is($objs->[1]->id, 2, "deep join with 3 - $db_type"); is($objs->[2]->id, 3, "deep join with 4 - $db_type"); is($objs->[16]->id, 17, "deep join with 5 - $db_type"); #SORT: #{ # $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; #} is($objs->[1]{'nicks'}[0]{'type'}{'name'}, 'nt four', "deep join with 6 - $db_type"); is($objs->[1]{'nicks'}[1]{'type'}{'name'}, 'nt two', "deep join with 7 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 2, "deep join with 8 - $db_type"); #SORT: #{ # $objs->[4]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[4]{'nicks'}} ]; #} is($objs->[4]{'nicks'}[0]{'type'}{'name'}, 'nt five', "deep join with 9 - $db_type"); is($objs->[4]{'nicks'}[1]{'type'}{'name'}, 'nt one', "deep join with 10 - $db_type"); is($objs->[4]{'nicks'}[2]{'type'}{'name'}, 'nt six', "deep join with 11 - $db_type"); is($objs->[4]{'nicks'}[3]{'type'}{'name'}, 'nt three', "deep join with 12 - $db_type"); is(scalar @{$objs->[4]{'nicks'}}, 4, "deep join with 13 - $db_type"); is(scalar @{$objs->[0]{'nicks'} ||= []}, 0, "deep join with 14 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyMySQLObject', require_objects => [ 'nicks.type', 'nicks.type', 'nicks' ], with_objects => [ 'nicks.type.t2', 'nicks.alts' ], multi_many_ok => 1, query => [ 'id' => [ 2, 5 ] ], sort_by => 'type.name'); $o = $iterator->next; is($o->{'nicks'}[0]{'type'}{'name'}, 'nt four', "deep join iterator 1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'name'}, 'nt two', "deep join iterator 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "deep join iterator 3 - $db_type"); is($o->{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt two 1', "deep join 3.1 - $db_type"); is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join iterator 3.1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join iterator 3.2 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'type'}{'name'}, 'nt five', "deep join iterator 4 - $db_type"); is($o->{'nicks'}[1]{'type'}{'name'}, 'nt one', "deep join iterator 5 - $db_type"); is($o->{'nicks'}[2]{'type'}{'name'}, 'nt six', "deep join iterator 6 - $db_type"); is($o->{'nicks'}[3]{'type'}{'name'}, 'nt three', "deep join iterator 7 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "deep join iterator 8 - $db_type"); $o->{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$o->{'nicks'}[1]{'alts'}} ]; is($o->{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt one 1', "deep join iterator 9 - $db_type"); is($o->{'nicks'}[1]{'alts'}[1]{'alt'}, 'alt one 2', "deep join iterator 10 - $db_type"); is($o->{'nicks'}[1]{'alts'}[2]{'alt'}, 'alt one 3', "deep join iterator 11 - $db_type"); is(scalar @{$o->{'nicks'}[1]{'alts'}}, 3, "deep join iterator 12 - $db_type"); ok(!$iterator->next, "deep join iterator 13 - $db_type"); is($iterator->total, 2, "deep join iterator 14 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyMySQLObject', with_objects => [ 'nicks.type' ], nonlazy => 1, sort_by => 'type.name'); $o = $iterator->next; is($o->id, 1, "deep join with with iterator 1 - $db_type"); $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; #} is($o->{'nicks'}[0]{'type'}{'name'}, 'nt four', "deep join with with iterator 1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'name'}, 'nt two', "deep join with iterator 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "deep join with iterator 3 - $db_type"); $o = $iterator->next; $o = $iterator->next; $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; #} is($o->{'nicks'}[0]{'type'}{'name'}, 'nt five', "deep join with iterator 4 - $db_type"); is($o->{'nicks'}[1]{'type'}{'name'}, 'nt one', "deep join with iterator 5 - $db_type"); is($o->{'nicks'}[2]{'type'}{'name'}, 'nt six', "deep join with iterator 6 - $db_type"); is($o->{'nicks'}[3]{'type'}{'name'}, 'nt three', "deep join with iterator 7 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "deep join with iterator 8 - $db_type"); while($iterator->next) { } is($iterator->total, 21, "deep join iterator 9 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', require_objects => [ 'nicks.type.t2' ], query => [ 'id' => [ 2, 5 ] ], nonlazy => 1, sort_by => 'type.name'); ok(@$objs == 2, "deep join three-level 1 - $db_type"); is($objs->[0]->id, 2, "deep join three-level 2 - $db_type"); is($objs->[1]->id, 5, "deep join three-level 3 - $db_type"); #SORT: #{ # $objs->[0]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[0]{'nicks'}} ]; #} is($objs->[0]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join three-level 4 - $db_type"); is($objs->[0]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join three-level 5 - $db_type"); is(scalar @{$objs->[0]{'nicks'}}, 2, "deep join three-level 6 - $db_type"); #SORT: #{ # $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; #} is($objs->[1]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 five', "deep join three-level 7 - $db_type"); is($objs->[1]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 one', "deep join three-level 8 - $db_type"); is($objs->[1]{'nicks'}[2]{'type'}{'t2'}{'name'}, 'nt2 six', "deep join three-level 9 - $db_type"); is($objs->[1]{'nicks'}[3]{'type'}{'t2'}{'name'}, 'nt2 three', "deep join three-level 10 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 4, "deep join three-level 11 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', with_objects => [ 'nicks.type.t2' ], nonlazy => 1, sort_by => 'type.name'); ok(@$objs == 21, "deep join three-level 1 - $db_type"); is($objs->[0]->id, 1, "deep join three-level 2 - $db_type"); is($objs->[1]->id, 2, "deep join three-level 3 - $db_type"); is($objs->[4]->id, 5, "deep join three-level 4 - $db_type"); is($objs->[20]->id, 60, "deep join three-level 5 - $db_type"); #SORT: #{ # $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; #} is($objs->[1]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join three-level 6 - $db_type"); is($objs->[1]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join three-level 7 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 2, "deep join three-level 8 - $db_type"); #SORT: #{ # $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; #} is($objs->[4]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 five', "deep join three-level 9 - $db_type"); is($objs->[4]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 one', "deep join three-level 10 - $db_type"); is($objs->[4]{'nicks'}[2]{'type'}{'t2'}{'name'}, 'nt2 six', "deep join three-level 11 - $db_type"); is($objs->[4]{'nicks'}[3]{'type'}{'t2'}{'name'}, 'nt2 three', "deep join three-level 12 - $db_type"); is(scalar @{$objs->[4]{'nicks'}}, 4, "deep join three-level 13 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyMySQLObject', require_objects => [ 'nicks.type.t2' ], query => [ 'id' => [ 2, 5 ] ], sort_by => 'type.name'); $o = $iterator->next; is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join iterator 1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join iterator 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "deep join iterator 3 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 five', "deep join iterator 4 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 one', "deep join iterator 5 - $db_type"); is($o->{'nicks'}[2]{'type'}{'t2'}{'name'}, 'nt2 six', "deep join iterator 6 - $db_type"); is($o->{'nicks'}[3]{'type'}{'t2'}{'name'}, 'nt2 three', "deep join iterator 7 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "deep join iterator 8 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyMySQLObject', with_objects => [ 'nicks.type.t2' ], nonlazy => 1, sort_by => 'type.name'); $o = $iterator->next; $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; #} is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join iterator with 1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join iterator with 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "deep join iterator with 3 - $db_type"); $o = $iterator->next; $o = $iterator->next; $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; #} is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 five', "deep join iterator with 4 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 one', "deep join iterator with 5 - $db_type"); is($o->{'nicks'}[2]{'type'}{'t2'}{'name'}, 'nt2 six', "deep join iterator with 6 - $db_type"); is($o->{'nicks'}[3]{'type'}{'t2'}{'name'}, 'nt2 three', "deep join iterator with 7 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "deep join iterator with 8 - $db_type"); while($iterator->next) { } is($iterator->total, 21, "deep join iterator with 9 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', require_objects => [ 'nicks.alts' ], multi_many_ok => 1, query => [ 'id' => [ 2, 5 ] ], sort_by => 'alts.alt'); ok(@$objs == 2, "deep join multi 1 - $db_type"); is($objs->[0]->id, 2, "deep join multi 2 - $db_type"); is($objs->[1]->id, 5, "deep join multi 3 - $db_type"); is($objs->[0]{'nicks'}[0]{'alts'}[0]{'alt'}, 'alt two 1', "deep join multi 4 - $db_type"); is(scalar @{$objs->[0]{'nicks'}[0]{'alts'}}, 1, "deep join multi 5 - $db_type"); is($objs->[1]{'nicks'}[0]{'alts'}[0]{'alt'}, 'alt one 1', "deep join multi 6 - $db_type"); is($objs->[1]{'nicks'}[0]{'alts'}[1]{'alt'}, 'alt one 2', "deep join multi 7 - $db_type"); is($objs->[1]{'nicks'}[0]{'alts'}[2]{'alt'}, 'alt one 3', "deep join multi 8 - $db_type"); is(scalar @{$objs->[1]{'nicks'}[0]{'alts'}}, 3, "deep join multi 11 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', with_objects => [ 'nicks.alts' ], multi_many_ok => 1, nonlazy => 1, sort_by => 'alts.alt'); ok(@$objs == 21, "deep join multi with 1 - $db_type"); is($objs->[1]->id, 2, "deep join multi with 2 - $db_type"); is($objs->[4]->id, 5, "deep join multi with 3 - $db_type"); #SORT: #{ # $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; # $objs->[1]{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$objs->[1]{'nicks'}[1]{'alts'}} ]; #} is($objs->[1]{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt two 1', "deep join multi with with 4 - $db_type"); is(scalar @{$objs->[1]{'nicks'}[1]{'alts'}}, 1, "deep join multi with 5 - $db_type"); #SORT: #{ # $objs->[4]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[4]{'nicks'}} ]; # $objs->[4]{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$objs->[4]{'nicks'}[3]{'alts'}} ]; #} is($objs->[4]{'nicks'}[3]{'alts'}[0]{'alt'}, 'alt one 1', "deep join multi with 6 - $db_type"); is($objs->[4]{'nicks'}[3]{'alts'}[1]{'alt'}, 'alt one 2', "deep join multi with 7 - $db_type"); is($objs->[4]{'nicks'}[3]{'alts'}[2]{'alt'}, 'alt one 3', "deep join multi with 8 - $db_type"); is(scalar @{$objs->[4]{'nicks'}[3]{'alts'}}, 3, "deep join multi with 11 - $db_type"); is(scalar @{$objs->[0]{'nicks'} || []}, 0, "deep join multi with 12 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyMySQLObject', require_objects => [ 'nicks.alts' ], multi_many_ok => 1, query => [ 'id' => [ 2, 5 ] ], sort_by => 'alts.alt'); $o = $iterator->next; is($o->id, 2, "deep join multi iter 1 - $db_type"); is($o->{'nicks'}[0]{'alts'}[0]{'alt'}, 'alt two 1', "deep join multi iter 2 - $db_type"); is(scalar @{$o->{'nicks'}[0]{'alts'}}, 1, "deep join multi iter 3 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'alts'}[0]{'alt'}, 'alt one 1', "deep join multi iter 4 - $db_type"); is($o->{'nicks'}[0]{'alts'}[1]{'alt'}, 'alt one 2', "deep join multi iter 5 - $db_type"); is($o->{'nicks'}[0]{'alts'}[2]{'alt'}, 'alt one 3', "deep join multi iter 6 - $db_type"); is(scalar @{$o->{'nicks'}[0]{'alts'}}, 3, "deep join multi iter 7 - $db_type"); ok(!$iterator->next, "deep join multi iter 8 - $db_type"); is($iterator->total, 2, "deep join multi iter 9 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyMySQLObject', with_objects => [ 'nicks.alts' ], multi_many_ok => 1, nonlazy => 1, #query => [ id => 2 ], sort_by => 'alts.alt'); $o = $iterator->next; is(scalar @{$o->{'nicks'} ||= []}, 0, "deep join multi iter with 1 - $db_type"); $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; # $o->{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$o->{'nicks'}[1]{'alts'}} ]; #} is($o->id, 2, "deep join multi iter with 2 - $db_type"); is($o->{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt two 1', "deep join multi iter with 3 - $db_type"); is(scalar @{$o->{'nicks'}[1]{'alts'}}, 1, "deep join multi iter with 4 - $db_type"); $o = $iterator->next; $o = $iterator->next; $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; # $o->{'nicks'}[3]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$o->{'nicks'}[3]{'alts'}} ]; #} is($o->{'nicks'}[3]{'alts'}[0]{'alt'}, 'alt one 1', "deep join multi iter with 5 - $db_type"); is($o->{'nicks'}[3]{'alts'}[1]{'alt'}, 'alt one 2', "deep join multi iter with 6 - $db_type"); is($o->{'nicks'}[3]{'alts'}[2]{'alt'}, 'alt one 3', "deep join multi iter with 7 - $db_type"); is(scalar @{$o->{'nicks'}[3]{'alts'}}, 3, "deep join multi iter with 8 - $db_type"); while($iterator->next) { } is($iterator->total, 21, "deep join multi iter with 9 - $db_type"); # End deep join tests # Start custom select tests my @selects = ( 't2.nick, id, t2.id, name, UPPER(name) AS derived, fk1', 't1.id, t2.nick, t2.id, t1.name, UPPER(name) AS derived, t1.fk1', 'rose_db_object_nicks.id, rose_db_object_test.id, rose_db_object_nicks.nick, rose_db_object_test.name, UPPER(name) AS derived', [ \q(t1.id + 0 AS id), qw(name t2.nick nicks.id), \q(UPPER(name) AS derived) ], [ qw(t2.nick t2.id t1.id t1.name), 'UPPER(name) AS derived' ], [ \q(UPPER(name) AS derived), qw(t2.id rose_db_object_nicks.nick rose_db_object_test.id rose_db_object_test.name) ], [ qw(rose_db_object_test.id rose_db_object_nicks.nick rose_db_object_test.name rose_db_object_nicks.id), 'UPPER(name) AS derived' ], [ qw(rose_db_object_test.id rose_db_object_test.name rose_db_object_nicks.nick t2.id), 'UPPER(name) AS derived' ], ); $i = 0; #local $Rose::DB::Object::Manager::Debug = 1; foreach my $select (@selects) { $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyMySQLObject', select => $select, require_objects => [ 'nicks' ], query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->nicks->[0]->nick && !defined $o->nicks->[0]->type_id && !defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->nicks->[0]->nick && !defined $o->nicks->[0]->type_id && !defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; ok(!$iterator->next, "custom select $i - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', select => $select, require_objects => [ 'nicks' ], query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; ok($objs->[0]->id > 2 && defined $objs->[0]->name && defined $objs->[0]->nicks->[0]->nick && !defined $objs->[0]->nicks->[0]->type_id && !defined $objs->[0]->flag2 && $objs->[0]->derived eq 'DERIVED: ' . uc($objs->[0]->name), "custom select $i - $db_type"); $i++; ok($objs->[1]->id > 2 && defined $objs->[1]->name && defined $objs->[1]->nicks->[0]->nick && !defined $objs->[1]->nicks->[0]->type_id && !defined $objs->[1]->flag2 && $objs->[1]->derived eq 'DERIVED: ' . uc($objs->[1]->name), "custom select $i - $db_type"); $i++; is(scalar @$objs, 2, "custom select $i - $db_type"); } @selects = ( 't2.nick, t1.*, t2.id, name, UPPER(name) AS derived', [ qw(t2.nick t2.id t1.*), 'UPPER(name) AS derived' ], ); #local $Rose::DB::Object::Manager::Debug = 1; foreach my $select (@selects) { $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyMySQLObject', select => $select, require_objects => [ 'nicks' ], query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->nicks->[0]->nick && !defined $o->nicks->[0]->type_id && defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->nicks->[0]->nick && !defined $o->nicks->[0]->type_id && defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; ok(!$iterator->next, "custom select $i - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', select => $select, require_objects => [ 'nicks' ], query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; ok($objs->[0]->id > 2 && defined $objs->[0]->name && defined $objs->[0]->nicks->[0]->nick && !defined $objs->[0]->nicks->[0]->type_id && defined $objs->[0]->flag2 && $objs->[0]->derived eq 'DERIVED: ' . uc($objs->[0]->name), "custom select $i - $db_type"); $i++; ok($objs->[1]->id > 2 && defined $objs->[1]->name && defined $objs->[1]->nicks->[0]->nick && !defined $objs->[1]->nicks->[0]->type_id && defined $objs->[1]->flag2 && $objs->[1]->derived eq 'DERIVED: ' . uc($objs->[1]->name), "custom select $i - $db_type"); $i++; is(scalar @$objs, 2, "custom select $i - $db_type"); } @selects = ( '*, name, UPPER(name) AS derived', [ '*', 'UPPER(name) AS derived' ], ); #local $Rose::DB::Object::Manager::Debug = 1; foreach my $select (@selects) { $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyMySQLObject', select => $select, query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; ok(!$iterator->next, "custom select $i - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyMySQLObject', select => $select, query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; ok($objs->[0]->id > 2 && defined $objs->[0]->name && defined $objs->[0]->flag2 && $objs->[0]->derived eq 'DERIVED: ' . uc($objs->[0]->name), "custom select $i - $db_type"); $i++; ok($objs->[1]->id > 2 && defined $objs->[1]->name && defined $objs->[1]->flag2 && $objs->[1]->derived eq 'DERIVED: ' . uc($objs->[1]->name), "custom select $i - $db_type"); $i++; is(scalar @$objs, 2, "custom select $i - $db_type"); } # End custom select tests } # # Informix # SKIP: foreach my $db_type (qw(informix)) { skip("Informix tests", 752) unless($HAVE_INFORMIX); Rose::DB->default_type($db_type); my($sql, $bind) = Rose::DB::Object::Manager->get_objects_sql( object_class => 'MyInformixObject', query => [ name => { like => \q('%foo%') } ]); ok($sql =~ /name LIKE '%foo%'/, "scalar ref bind 1 - $db_type"); is(@$bind, 0, "scalar ref bind 2 - $db_type"); ($sql, $bind) = Rose::DB::Object::Manager->get_objects_sql( object_class => 'MyInformixObject', require_objects => [ 'bb1' ], query => [ 'bb1.name' => { like => \q('%foo%') } ]); ok($sql =~ /name LIKE '%foo%'/, "scalar ref bind 3 - $db_type"); is(@$bind, 0, "scalar ref bind 4 - $db_type"); ($sql, $bind) = Rose::DB::Object::Manager->get_objects_sql( object_class => 'MyInformixObject', require_objects => [ 'bb1' ], query => [ or => [ name => 'bar', 'bb1.name' => { like => \q('%foo%') }, ], ]); ok($sql =~ /t2\.name LIKE '%foo%'/, "scalar ref bind 5 - $db_type"); is(@$bind, 1, "scalar ref bind 6 - $db_type"); my $o = MyInformixObject->new(id => 1, name => 'John', flag => 't', flag2 => 'f', fkone => 2, status => 'active', bits => '00001', start => '2001-01-02', save_col => 5, nums => [ 1, 2, 3 ], last_modified => 'now', date_created => '2004-03-30 12:34:56'); ok($o->save, "object save() 1 - $db_type"); my $objs = MyInformixObject->get_objectz( #debug => 1, share_db => 1, #hints => { comment => '+FIRST_ROWS' }, #hints => { first_rows => 1 }, #hints => { rose_db_object_test => { first_rows => 1, comment => 'FOO' } }, #hints => { t1 => { first_rows => 1 } }, query => [ id => { ge => 1 }, name => 'John', flag => 't', flag2 => 'f', status => 'active', bits => '00001', fixed => { like => 'nee%' }, or => [ and => [ '!bits' => '00001', bits => { ne => '11111' } ], and => [ bits => { lt => '10101' }, '!bits' => '10000' ] ], start => '01/02/2001', save_col => [ 1, 5 ], nums => 'SET{1,2,3}', fk1 => 2, last_modified => { le => $o->db->format_timestamp($o->db->parse_timestamp('now')) }, date_created => '2004-03-30 12:34:56', date_created => { le => 'current' }, date_created => [ 'current', '2004-03-30 12:34:56' ], ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() 2 - $db_type"); my $o2 = $o->clone; $o2->id(2); $o2->name('Fred'); ok($o2->save, "object save() 2 - $db_type"); my $o3 = $o2->clone; $o3->id(3); $o3->name('Sue'); ok($o3->save, "object save() 3 - $db_type"); my $o4 = $o3->clone; $o4->id(4); $o4->name('Bob'); ok($o4->save, "object save() 4 - $db_type"); eval { $objs = MyInformixObjectManager->get_objectz( query => [ date_created => '205-1-2', # invalid date ]); }; ok($@, "Invalid date - $db_type"); eval { $objs = MyInformixObjectManager->get_objectz( query => [ flag => [] ]); }; ok($@, "Empty list 1 - $db_type"); $objs = MyInformixObjectManager->get_objectz( allow_empty_lists => 1, query => [ flag => [] ]); is(scalar @$objs, 4, "Empty list 2 - $db_type"); eval { $objs = MyInformixObjectManager->get_objectz( query => [ or => [ flag => 1, status => [] ] ]); }; ok($@, "Empty list 3 - $db_type"); $objs = MyInformixObjectManager->get_objectz( allow_empty_lists => 1, query => [ or => [ flag => 1, status => [] ] ]); is(scalar @$objs, 4, "Empty list 4 - $db_type"); $objs = MyInformixObjectManager->get_objectz( share_db => 1, query => [ id => { ge => 2 }, name => { like => '%e%' }, flag => 't', flag2 => 'f', status => 'active', bits => '00001', start => '01/02/2001', save_col => [ 1, 5 ], nums => 'SET{1,2,3}', last_modified => { le => $o->db->format_timestamp($o->db->parse_timestamp('now')) }, date_created => '2004-03-30 12:34:56', status => { like => 'AC%', field => 'UPPER(status)' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'name DESC'); is(ref $objs, 'ARRAY', "get_objects() 3 - $db_type"); $objs ||= []; is(scalar @$objs, 2, "get_objects() 4 - $db_type"); is($objs->[0]->id, 3, "get_objects() 5 - $db_type"); is($objs->[1]->id, 2, "get_objects() 6 - $db_type"); my $count = MyInformixObject->get_objectz_count( share_db => 1, query => [ id => { ge => 2 }, name => { like => '%e%' }, flag => 't', flag2 => 'f', status => 'active', bits => '00001', start => '01/02/2001', save_col => [ 1, 5 ], nums => 'SET{1,2,3}', last_modified => { le => $o->db->format_timestamp($o->db->parse_timestamp('now')) }, date_created => '2004-03-30 12:34:56', status => { like => 'AC%', field => 'UPPER(status)' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'name DESC'); is($count, 2, "get_objects_count() 1 - $db_type"); # Set up sub-object for this one test my $b1 = MyInformixBB->new(id => 1, name => 'one'); $b1->save; $objs->[0]->b1(1); $objs->[0]->save; $count = MyInformixObjectManager->get_objectz_count( share_db => 1, query_is_sql => 1, require_objects => [ 'bb1' ], query => [ 't2.name' => { like => 'o%' }, 't2_name' => { like => 'on%' }, 'bb1.name' => { like => '%n%' }, id => { ge => 2 }, name => { like => '%e%' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'name DESC'); is($count, 1, "get_objects_count() require 1 - $db_type"); # Clear sub-object $objs->[0]->b1(undef); $objs->[0]->save; $b1->delete; my $save_o = $o; my $iterator = MyInformixObjectManager->get_objectz_iterator( share_db => 1, query => [ id => { ge => 2 }, name => { like => '%e%' }, flag => 't', flag2 => 'f', status => 'active', bits => '00001', start => '01/02/2001', save_col => [ 1, 5 ], nums => 'SET{1,2,3}', last_modified => { le => $o->db->format_timestamp($o->db->parse_timestamp('now')) }, date_created => '2004-03-30 12:34:56', status => { like => 'AC%', field => 'UPPER(status)' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'name'); is(ref $iterator, 'Rose::DB::Object::Iterator', "get_objects_iterator() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "iterator next() 1 - $db_type"); is($o->id, 2, "iterator next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Sue', "iterator next() 3 - $db_type"); is($o->id, 3, "iterator next() 4 - $db_type"); $o = $iterator->next; is($o, 0, "iterator next() 5 - $db_type"); is($iterator->total, 2, "iterator total() - $db_type"); $iterator = MyInformixObject->get_objectz_iterator( share_db => 1, skip_first => 1, query => [ id => { ge => 2 }, name => { like => '%e%' }, flag => 't', flag2 => 'f', status => 'active', bits => '00001', start => '01/02/2001', save_col => [ 1, 5 ], nums => 'SET{1,2,3}', last_modified => { le => $save_o->db->format_timestamp($save_o->db->parse_timestamp('now')) }, date_created => '2004-03-30 12:34:56', status => { like => 'AC%', field => 'UPPER(status)' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'name'); $o = $iterator->next; is($o->name, 'Sue', "iterator skip_first next() 1 - $db_type"); is($o->id, 3, "iterator skip_first next() 2 - $db_type"); $o = $iterator->next; is($o, 0, "iterator skip_first next() 3 - $db_type"); is($iterator->total, 1, "iterator total() - $db_type"); my $fo = MyInformixOtherObject->new(name => 'Foo 1', k1 => 1, k2 => 2, k3 => 3); ok($fo->save, "object save() 5 - $db_type"); $fo = MyInformixOtherObject->new(name => 'Foo 2', k1 => 2, k2 => 3, k3 => 4); ok($fo->save, "object save() 6 - $db_type"); $fo = MyInformixBB->new(id => 1, name => 'one'); ok($fo->save, "bb object save() 1 - $db_type"); $fo = MyInformixBB->new(id => 2, name => 'two'); ok($fo->save, "bb object save() 2 - $db_type"); $fo = MyInformixBB->new(id => 3, name => 'three'); ok($fo->save, "bb object save() 3 - $db_type"); $fo = MyInformixBB->new(id => 4, name => 'four'); ok($fo->save, "bb object save() 4 - $db_type"); my $o5 = MyInformixObject->new(id => 5, name => 'Betty', flag => 'f', flag2 => 't', status => 'with', bits => '10101', start => '2002-05-20', save_col => 123, nums => [ 4, 5, 6 ], fkone => 1, fk2 => 2, fk3 => 3, b1 => 2, b2 => 4, last_modified => '2001-01-10 20:34:56', date_created => '2002-05-10 10:34:56'); ok($o5->save, "object save() 7 - $db_type"); my $fo1 = $o5->other_obj; ok($fo1 && ref $fo1 && $fo1->k1 == 1 && $fo1->k2 == 2 && $fo1->k3 == 3, "foreign object 1 - $db_type"); $fo1 = $o5->bb1; ok($fo1 && ref $fo1 && $fo1->id == 2, "bb foreign object 1 - $db_type"); $fo1 = $o5->bb2; ok($fo1 && ref $fo1 && $fo1->id == 4, "bb foreign object 2 - $db_type"); $objs = MyInformixObjectManager->get_objectz( share_db => 1, query => [ id => { ge => 2 }, name => { like => '%tt%' }, ], require_objects => [ 'other_obj' ]); ok(ref $objs->[0]->{'other_obj'} eq 'MyInformixOtherObject', "foreign object 2 - $db_type"); is($objs->[0]->other_obj->k2, 2, "foreign object 3 - $db_type"); is($objs->[0]->bb1->name, 'two', "bb foreign object 3 - $db_type"); is($objs->[0]->bb2->name, 'four', "bb foreign object 4 - $db_type"); # Start "one to many" tests ok($fo = MyInformixNick->new(id => 1, o_id => 5, nick => 'none', type => { name => 'nt one', t2 => { name => 'nt2 one' } }, alts => [ { alt => 'alt one 1' }, { alt => 'alt one 2' }, { alt => 'alt one 3' }, ], opts => [ { opt => 'opt one 1' }, { opt => 'opt one 2' } ])->save, "nick object save() 1 - $db_type"); $fo = MyInformixNick->new(id => 2, o_id => 2, nick => 'ntwo', type => { name => 'nt two', t2 => { name => 'nt2 two' } }, alts => [ { alt => 'alt two 1' } ]); ok($fo->save, "nick object save() 2 - $db_type"); $fo = MyInformixNick->new(id => 3, o_id => 5, nick => 'nthree', type => { name => 'nt three', t2 => { name => 'nt2 three' } }, opts => [ { opt => 'opt three 1' }, { opt => 'opt three 2' } ]); ok($fo->save, "nick object save() 3 - $db_type"); $fo = MyInformixNick->new(id => 4, o_id => 2, nick => 'nfour', type => { name => 'nt four', t2 => { name => 'nt2 four' } }); ok($fo->save, "nick object save() 4 - $db_type"); $fo = MyInformixNick->new(id => 5, o_id => 5, nick => 'nfive', type => { name => 'nt five', t2 => { name => 'nt2 five' } }); ok($fo->save, "nick object save() 5 - $db_type"); $fo = MyInformixNick->new(id => 6, o_id => 5, nick => 'nsix', type => { name => 'nt six', t2 => { name => 'nt2 six' } }); ok($fo->save, "nick object save() 6 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', share_db => 1, with_objects => [ 'nicks' ], query => [ id => { ge => 1 }, 't1.name' => 'Betty', flag => 'f', flag2 => 1, bits => '10101', 't2.nick' => { like => 'n%' }, start => '5/20/2002', '!start' => { gt => DateTime->new(year => '2005', month => 12, day => 1) }, '!rose_db_object_test.start' => { gt => DateTime->new(year => '2005', month => 12, day => 2) }, '!t1.start' => { gt => DateTime->new(year => '2005', month => 12, day => 3) }, or => [], and => [], save_col => [ 1, 5, 123 ], nums => [ 4, 5, 6 ], fk1 => 1, last_modified => { le => '6/6/2020' }, # XXX: breaks in 2020! date_created => '5/10/2002 10:34:56 am' ], clauses => [ "LOWER(status) LIKE 'w%'" ], sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() with many 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() with many 2 - $db_type"); ok(!defined $objs->[0]->{'status'}, "lazy main 1 - $db_type"); is($objs->[0]->status, 'with', "lazy main 2 - $db_type"); my $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many 3 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many 4 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many 5 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many 6 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many 7 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', share_db => 1, with_objects => [ 'bb2', 'nicks', 'bb1' ], query => [ 't1.id' => { ge => 1 }, 't1.name' => 'Betty', flag => 'f', flag2 => 1, bits => '10101', 't3.nick' => { like => 'n%' }, start => '5/20/2002', '!start' => { gt => DateTime->new(year => '2005', month => 12, day => 1) }, '!rose_db_object_test.start' => { gt => DateTime->new(year => '2005', month => 12, day => 2) }, '!t1.start' => { gt => DateTime->new(year => '2005', month => 12, day => 3) }, save_col => [ 1, 5, 123 ], nums => [ 4, 5, 6 ], fk1 => 1, last_modified => { le => '6/6/2020' }, # XXX: breaks in 2020! date_created => '5/10/2002 10:34:56 am' ], clauses => [ "LOWER(status) LIKE 'w%'" ], sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() with many 8 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() with many 9 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many 10 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many 11 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many 12 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many 13 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many 14 - $db_type"); $fo1 = $objs->[0]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects() with many bb1 1 - $db_type"); $fo1 = $objs->[0]->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects() with many bb2 2 - $db_type"); $iterator = MyInformixObjectManager->get_objectz_iterator( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => 1, sort_by => 't1.name'); is(ref $iterator, 'Rose::DB::Object::Iterator', "get_objects_iterator() 1 - $db_type"); $o = $iterator->next; is($o->name, 'Betty', "iterator many next() 1 - $db_type"); is($o->id, 5, "iterator many next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Bob', "iterator many next() 3 - $db_type"); is($o->id, 4, "iterator many next() 4 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "iterator many next() 5 - $db_type"); is($o->id, 2, "iterator many next() 6 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "iterator many sub-object 1 - $db_type"); is($o->{'nicks'}[0]{'nick'}, 'ntwo', "iterator many sub-object 2 - $db_type"); is($o->{'nicks'}[1]{'nick'}, 'nfour', "iterator many sub-object 3 - $db_type"); $o = $iterator->next; is($o->name, 'Sue', "iterator many next() 7 - $db_type"); is($o->id, 3, "iterator many next() 8 - $db_type"); $o = $iterator->next; is($o, 0, "iterator many next() 9 - $db_type"); is($iterator->total, 4, "iterator many total() - $db_type"); $iterator = MyInformixObjectManager->get_objectz_iterator( share_db => 1, with_objects => [ 'bb2', 'nicks' ], limit_with_subselect => 0, query => [ 't1.id' => { ge => 2 }, ], sort_by => 't1.name', limit => 2); $o = $iterator->next; is($o->name, 'Betty', "iterator limit 2 many next() 1 - $db_type"); is($o->id, 5, "iterator limit 2 many next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Bob', "iterator limit 2 many next() 3 - $db_type"); is($o->id, 4, "iterator limit 2 many next() 4 - $db_type"); $o = $iterator->next; is($o, 0, "iterator limit 2 many next() 5 - $db_type"); is($iterator->total, 2, "iterator limit 2 many total() - $db_type"); $iterator = MyInformixObjectManager->get_objectz_iterator( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], limit_with_subselect => 0, nonlazy => [ 'nicks' ], sort_by => 't1.name', limit => 3); $o = $iterator->next; is($o->name, 'Betty', "iterator limit 3 many next() 1 - $db_type"); is($o->id, 5, "iterator limit 3 many next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Bob', "iterator limit 3 many next() 3 - $db_type"); is($o->id, 4, "iterator limit 3 many next() 4 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "iterator limit 3 many next() 5 - $db_type"); is($o->id, 2, "iterator limit 3 many next() 6 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "iterator limit 3 many sub-object 1 - $db_type"); is($o->{'nicks'}[0]{'nick'}, 'ntwo', "iterator limit 3 many sub-object 2 - $db_type"); is($o->{'nicks'}[1]{'nick'}, 'nfour', "iterator limit 3 many sub-object 3 - $db_type"); $o = $iterator->next; is($o, 0, "iterator limit 3 many next() 7 - $db_type"); is($iterator->total, 3, "iterator limit 3 many total() - $db_type"); $objs = MyInformixObjectManager->get_objectz( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], limit_with_subselect => 0, sort_by => 't1.name', limit => 2); ok(ref $objs && @$objs == 2, "get_objects() limit 2 many 1 - $db_type"); is($objs->[0]->name, 'Betty', "get_objects() limit 2 many 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() limit 2 many 3 - $db_type"); is($objs->[1]->name, 'Bob', "get_objects() limit 2 many 4 - $db_type"); is($objs->[1]->id, 4, "get_objects() limit 2 many 5 - $db_type"); $objs = MyInformixObjectManager->get_objectz( share_db => 1, with_objects => [ 'nicks', 'bb2' ], query => [ 't1.id' => { ge => 2 }, ], limit_with_subselect => 0, nonlazy => 1, sort_by => 't1.name', limit => 3); ok(ref $objs && @$objs == 3, "get_objects() limit 3 many 1 - $db_type"); is($objs->[0]->name, 'Betty', "get_objects() limit 3 many 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() limit 3 many 3 - $db_type"); is($objs->[1]->name, 'Bob', "get_objects() limit 3 many 4 - $db_type"); is($objs->[1]->id, 4, "get_objects() limit 3 many 5 - $db_type"); is($objs->[2]->name, 'Fred', "get_objects() limit 3 many 6 - $db_type"); is($objs->[2]->id, 2, "get_objects() limit 3 many 7 - $db_type"); is(scalar @{$objs->[2]->{'nicks'}}, 2, 'get_objects() limit 3 many sub-object 1'); is($objs->[2]->{'nicks'}[0]{'nick'}, 'ntwo', 'get_objects() limit 3 many sub-object 2'); is($objs->[2]->{'nicks'}[1]{'nick'}, 'nfour', 'get_objects() limit 3 many sub-object 3'); $iterator = MyInformixObjectManager->get_objectz_iterator( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], limit_with_subselect => 0, nonlazy => 1, sort_by => 't1.name', limit => 2, offset => 1); $o = $iterator->next; is($o->name, 'Bob', "iterator limit 2 offset 1 many next() 1 - $db_type"); is($o->id, 4, "iterator limit 2 offset 1 many next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "iterator limit 2 offset 1 many next() 3 - $db_type"); is($o->id, 2, "iterator limit 2 offset 1 many next() 4 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, 'iterator limit 2 offset 1 many sub-object 1'); is($o->{'nicks'}[0]{'nick'}, 'ntwo', 'iterator limit 2 offset 1 many sub-object 2'); is($o->{'nicks'}[1]{'nick'}, 'nfour', 'iterator limit 2 offset 1 many sub-object 3'); $o = $iterator->next; is($o, 0, "iterator limit 2 offset 1 many next() 5 - $db_type"); is($iterator->total, 2, "iterator limit 2 offset 1 many total() - $db_type"); $iterator = MyInformixObjectManager->get_objectz_iterator( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], limit_with_subselect => 0, nonlazy => 1, sort_by => 't1.name', limit => 3, offset => 2); $o = $iterator->next; is($o->name, 'Fred', "iterator limit 3 offset 2 many next() 1 - $db_type"); is($o->id, 2, "iterator limit 3 offset 2 many next() 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, 'iterator limit 3 offset 2 many sub-object 1'); is($o->{'nicks'}[0]{'nick'}, 'ntwo', 'iterator limit 3 offset 2 many sub-object 2'); is($o->{'nicks'}[1]{'nick'}, 'nfour', 'iterator limit 3 offset 2 many sub-object 3'); $o = $iterator->next; is($o->name, 'Sue', "iterator limit 3 offset 2 many next() 3 - $db_type"); is($o->id, 3, "iterator limit 3 offset 2 many next() 4 - $db_type"); $o = $iterator->next; is($o, 0, "iterator limit 3 offset 2 many next() 5 - $db_type"); is($iterator->total, 2, "iterator limit 3 offset 2 many total() - $db_type"); $objs = MyInformixObjectManager->get_objectz( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], limit_with_subselect => 0, nonlazy => 1, sort_by => 't1.name', limit => 2, offset => 1); ok(ref $objs && @$objs == 2, "get_objects() limit 2 offset 1 many 1 - $db_type"); is($objs->[0]->name, 'Bob', "get_objects() limit 2 offset 1 many 2 - $db_type"); is($objs->[0]->id, 4, "get_objects() limit 2 offset 1 many 3 - $db_type"); is($objs->[1]->name, 'Fred', "get_objects() limit 2 offset 1 many 4 - $db_type"); is($objs->[1]->id, 2, "get_objects() limit 2 offset 1 many 5 - $db_type"); is(scalar @{$objs->[1]->{'nicks'}}, 2, 'get_objects() limit 2 offset 1 many sub-object 1'); is($objs->[1]->{'nicks'}[0]{'nick'}, 'ntwo', 'get_objects() limit 2 offset 1 many sub-object 2'); is($objs->[1]->{'nicks'}[1]{'nick'}, 'nfour', 'get_objects() limit 2 offset 1 many sub-object 3'); $objs = MyInformixObjectManager->get_objectz( share_db => 1, with_objects => [ 'nicks', 'bb2' ], query => [ 't1.id' => { ge => 2 }, ], limit_with_subselect => 0, nonlazy => 1, sort_by => 't1.name', limit => 3, offset => 2); ok(ref $objs && @$objs == 2, "get_objects() limit 3 offset 2 many 1 - $db_type"); is($objs->[0]->name, 'Fred', "get_objects() limit 3 offset 2 many 2 - $db_type"); is($objs->[0]->id, 2, "get_objects() limit 3 offset 2 many 3 - $db_type"); is(scalar @{$objs->[0]->{'nicks'}}, 2, 'get_objects() limit 3 offset 2 many sub-object 1'); is($objs->[0]->{'nicks'}[0]{'nick'}, 'ntwo', 'get_objects() limit 3 offset 2 many sub-object 2'); is($objs->[0]->{'nicks'}[1]{'nick'}, 'nfour', 'get_objects() limit 3 offset 2 many sub-object 3'); is($objs->[1]->name, 'Sue', "get_objects() limit 3 offset 2 many 4 - $db_type"); is($objs->[1]->id, 3, "get_objects() limit 3 offset 2 many 5 - $db_type"); my $o6 = $o2->clone; $o6->id(60); $o6->fkone(undef); $o6->fk2(undef); $o6->fk3(undef); $o6->b1(undef); $o6->b2(2); $o6->name('Ted'); ok($o6->save, "object save() 8 - $db_type"); my $o7 = $o2->clone; $o7->id(70); $o7->b1(3); $o7->b2(undef); $o7->name('Joe'); ok($o7->save, "object save() 9 - $db_type"); my $o8 = $o2->clone; $o8->id(80); $o8->b1(undef); $o8->b2(undef); $o8->name('Pete'); ok($o8->save, "object save() 10 - $db_type"); ok($fo->save, "object save() 10 - $db_type"); $fo = MyInformixNick->new(id => 7, o_id => 60, nick => 'nseven'); ok($fo->save, "nick object save() 7 - $db_type"); $fo = MyInformixNick->new(id => 8, o_id => 60, nick => 'neight'); ok($fo->save, "nick object save() 8 - $db_type"); $fo = MyInformixNick->new(id => 9, o_id => 60, nick => 'neight'); ok($fo->save, "nick object save() 8 - $db_type"); $fo = MyInformixNick2->new(id => 1, o_id => 5, nick2 => 'n2one'); ok($fo->save, "nick2 object save() 1 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', share_db => 1, require_objects => [ 'bb2', 'bb1' ], query => [ '!t1.id' => 5 ], sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() with many 15 - $db_type"); $objs ||= []; is(scalar @$objs, 0, "get_objects() with many 16 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( object_class => 'MyInformixObject', share_db => 1, require_objects => [ 'bb2', 'bb1' ], with_objects => [ 'nicks' ], query => [ ], sort_by => 't1.id'); is($count, 1, "get_objects_count() require 1 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; $count = Rose::DB::Object::Manager->get_objects_count( object_class => 'MyInformixObject', share_db => 1, require_objects => [ 'bb2' ], with_objects => [ 'nicks' ], query => [ ], sort_by => 't1.id'); is($count, 2, "get_objects_count() require 2 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', share_db => 1, require_objects => [ 'bb2', 'bb1' ], with_objects => [ 'nicks' ], query => [ ], sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() with many 17 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() with many 18 - $db_type"); is($objs->[0]->id, 5, "get_objects() with many 19 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many 20 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many 21 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many 22 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many 23 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many 24 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', share_db => 1, require_objects => [ 'bb1', 'bb2' ], with_objects => [ 'nicks2', 'nicks' ], multi_many_ok => 1, query => [ ], sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() with multi many 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() with multi many 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() with multi many 3 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with multi many 4 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with multi many 5 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with multi many 6 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with multi many 7 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with multi many 8 - $db_type"); is($objs->[0]->{'nicks2'}[0]{'nick2'}, 'n2one', "get_objects() with multi many 9 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyInformixObject', share_db => 1, require_objects => [ 'bb1', 'bb2' ], with_objects => [ 'nicks2', 'nicks' ], multi_many_ok => 1, query => [ ], sort_by => 't1.id'); $o = $iterator->next; is($o->name, 'Betty', "iterator with and require 1 - $db_type"); is($o->id, 5, "iterator with and require 2 - $db_type"); $nicks = $o->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "iterator with and require 3 - $db_type"); is($nicks->[0]->nick, 'nthree', "iterator with and require 4 - $db_type"); is($nicks->[1]->nick, 'nsix', "iterator with and require 5 - $db_type"); is($nicks->[2]->nick, 'none', "iterator with and require 6 - $db_type"); is($nicks->[3]->nick, 'nfive', "iterator with and require 7 - $db_type"); is($o->{'nicks2'}[0]{'nick2'}, 'n2one', "iterator with and require 8 - $db_type"); $o = $iterator->next; is($o, 0, "iterator with and require 9 - $db_type"); is($iterator->total, 1, "iterator with and require 10 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', share_db => 1, with_objects => [ 'bb2', 'nicks', 'bb1' ], query => [ ], sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() with many 25 - $db_type"); $objs ||= []; is(scalar @$objs, 8, "get_objects() with many 26 - $db_type"); my $ids = join(',', map { $_->id } @$objs); is($ids, '1,2,3,4,5,60,70,80', "get_objects() with many 27 - $db_type"); $nicks = $objs->[4]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many 28 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many 29 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many 30 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many 31 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many 32 - $db_type"); is($objs->[6]->{'bb1'}->{'name'}, 'three', "get_objects() with many 33 - $db_type"); ok(!defined $objs->[6]->{'bb2'}, "get_objects() with many 34 - $db_type"); ok(!defined $objs->[6]->{'nicks'}, "get_objects() with many 35 - $db_type"); ok(!defined $objs->[7]->{'bb1'}, "get_objects() with many 36 - $db_type"); ok(!defined $objs->[7]->{'bb1'}, "get_objects() with many 37 - $db_type"); ok(!defined $objs->[7]->{'nicks'}, "get_objects() with many 38 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 0; $fo = MyInformixNick->new(id => 7); ok($fo->delete, "with many clean-up 1 - $db_type"); $fo = MyInformixNick->new(id => 8); ok($fo->delete, "with many clean-up 2 - $db_type"); $fo = MyInformixNick->new(id => 9); ok($fo->delete, "with many clean-up 3 - $db_type"); ok($o6->delete, "with many clean-up 4 - $db_type"); ok($o7->delete, "with many clean-up 5 - $db_type"); ok($o8->delete, "with many clean-up 6 - $db_type"); $fo = MyInformixNick2->new(id => 1); ok($fo->delete, "with many clean-up 7 - $db_type"); # End "one to many" tests $iterator = MyInformixObject->get_objectz_iterator( share_db => 1, query => [ 't1.id' => { ge => 2 }, 't1.name' => { like => '%tt%' }, ], require_objects => [ 'other_obj' ]); $o = $iterator->next; ok(ref $o->{'other_obj'} eq 'MyInformixOtherObject', "foreign object 4 - $db_type"); is($o->other_obj->k2, 2, "foreign object 5 - $db_type"); is($o->bb1->name, 'two', "bb foreign object 5 - $db_type"); is($o->bb2->name, 'four', "bb foreign object 6 - $db_type"); $objs = MyInformixObjectManager->get_objectz( share_db => 1, query => [ id => { ge => 1 }, name => 'John', flag => 1, flag2 => 0, \q((1 = 1 and 5 > 2)), [ \q(fk1 > ?), 1 ], or => [ bits => '1', \q((2 = 2 and 6 > 3)), fk1 => { gt => 1 }, and => [ status => 'active', [ \q(7 > ?), 3 ], ], ], status => 'active', bits => '1', start => '1/2/2001', '!start' => { gt => DateTime->new(year => '2005', month => 1, day => 1) }, '!rose_db_object_test.start' => { gt => DateTime->new(year => '2005', month => 2, day => 2) }, '!t1.start' => { gt => DateTime->new(year => '2005', month => 3, day => 3) }, save_col => [ 1, 5 ], nums => [ 1, 2, 3 ], fk1 => 2, fk1 => { lt => 99 }, fk1 => { lt => 100 }, or => [ nums => { in_set => [ 2, 22, 222 ] }, fk1 => { lt => 777 }, last_modified => '6/6/2020' ], nums => { any_in_set => [ 1, 99, 100 ] }, nums => { in_set => [ 2, 22, 222 ] }, nums => { in_set => 2 }, nums => { all_in_set => [ 1, 2, 3 ] }, last_modified => { le => '6/6/2020' }, # XXX: test breaks in 2020! date_created => '3/30/2004 12:34:56 pm' ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() 7 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() 8 - $db_type"); $objs = MyInformixObject->get_objectz( share_db => 1, query => [ id => { ge => 2 }, k1 => { lt => 900 }, or => [ k1 => { ne => 99 }, k1 => 100 ], or => [ and => [ id => { ne => 123 }, id => { lt => 100 } ], and => [ id => { ne => 456 }, id => { lt => 300 } ] ], '!k2' => { gt => 999 }, '!t2.name' => 'z', start => { lt => DateTime->new(year => '2005', month => 1, day => 1) }, '!start' => { gt => DateTime->new(year => '2005', month => 1, day => 1) }, 'rose_db_object_test.name' => { like => '%tt%' }, '!rose_db_object_other.name' => 'q', '!rose_db_object_other.name' => [ 'x', 'y' ], ], require_objects => [ 'other_obj' ]); ok(ref $objs->[0]->{'other_obj'} eq 'MyInformixOtherObject', "foreign object 6 - $db_type"); is($objs->[0]->other_obj->k2, 2, "foreign object 7 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; $objs = MyInformixObjectManager->get_objectz( share_db => 1, queryis_sql => 1, query => [ id => { ge => 1 }, name => 'John', nums => { any_in_set => [ 1, 99, 100 ] }, '!nums' => { any_in_set => [ 7, 9 ] }, nums => { in_set => [ 2, 22, 222 ] }, nums => { in_set => 2 }, nums => { all_in_set => [ 1, 2, 3 ] }, '!nums' => { all_in_set => [ 1, 2, 72 ] }, ], limit => 5, sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() 9 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() 10 - $db_type"); # Test limit with offset foreach my $id (6 .. 20) { my $o = $o5->clone; $o->id($id); $o->name("Clone $id"); ok($o->save, "object save() clone $id - $db_type"); } $objs = MyInformixObject->get_objectz( sort_by => 'id DESC', limit => 2, offset => 8); ok(ref $objs eq 'ARRAY' && @$objs == 2 && $objs->[0]->id == 12 && $objs->[1]->id == 11, "get_objects() with offset - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; $objs = MyInformixObjectManager->get_objectz( sort_by => 'id DESC', require_objects => [ 'other_obj' ], limit => 2, offset => 8); ok(ref $objs eq 'ARRAY' && @$objs == 2 && $objs->[0]->id == 12 && $objs->[1]->id == 11, "get_objects() with objects and offset - $db_type"); $iterator = MyInformixObject->get_objectz_iterator( sort_by => 'id DESC', limit => 2, offset => 8); $o = $iterator->next; is($o->id, 12, "get_objects_iterator() with offset 1 - $db_type"); $o = $iterator->next; is($o->id, 11, "get_objects_iterator() with offset 2 - $db_type"); is($iterator->next, 0, "get_objects_iterator() with offset 3 - $db_type"); eval { $objs = MyInformixObjectManager->get_objectz( object_class => 'MyInformixObject', sort_by => 'id DESC', offset => 8) }; ok($@ =~ /invalid without a limit/, "get_objects() missing offset - $db_type"); eval { $iterator = MyInformixObject->get_objectz_iterator( object_class => 'MyInformixObject', sort_by => 'id DESC', offset => 8); }; ok($@ =~ /invalid without a limit/, "get_objects_iterator() missing offset - $db_type"); # Start *_sql comparison tests $o6->fk2(99); $o6->fk3(99); $o6->save; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', query => [ 'fk2' => { eq_sql => 'fk3' } ], sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq_sql 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() eq_sql 2 - $db_type"); is($objs->[0]->id, 60, "get_objects() eq_sql 3 - $db_type"); # End *_sql comparison tests # Start IN NULL tests #local $Rose::DB::Object::Manager::Debug = 1; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', query => [ id => [ undef, 60 ], '!id' => \'id + 1' ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() in null 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() in null 2 - $db_type"); is($objs->[0]->id, 60, "get_objects() in null 3 - $db_type"); # End IN NULL tests # Start scalar ref tests #local $Rose::DB::Object::Manager::Debug = 1; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', query => [ 'fk2' => \'fk3' ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq ref 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() eq ref 2 - $db_type"); is($objs->[0]->id, 60, "get_objects() eq ref 3 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', query => [ 'fk2' => [ \'fk3' ] ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq ref 4 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() eq ref 5 - $db_type"); is($objs->[0]->id, 60, "get_objects() eq ref 6 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', query => [ 'fk2' => { ne => \'fk3' } ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq ref 7 - $db_type"); $objs ||= []; is(scalar @$objs, 16, "get_objects() eq ref 8 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', query => [ 'fk2' => { ne => [ \'fk3' ] } ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq ref 9 - $db_type"); $objs ||= []; is(scalar @$objs, 16, "get_objects() eq ref 10 - $db_type"); # End scalar ref tests # Start "many to many" tests $fo = MyInformixColor->new(id => 1, name => 'Red'); $fo->save; $fo = MyInformixColor->new(id => 2, name => 'Green'); $fo->save; $fo = MyInformixColor->new(id => 3, name => 'Blue'); $fo->save; $fo = MyInformixColorMap->new(id => 1, object_id => $o2->id, color_id => 1); $fo->save; $fo = MyInformixColorMap->new(id => 2, object_id => $o2->id, color_id => 3); $fo->save; $o2->b1(4); $o2->b1(2); $o2->fkone(2); $o2->fk2(3); $o2->fk3(4); $o2->save; my @colors = $o2->colors; ok(@colors == 2 && $colors[0]->name eq 'Red' && $colors[1]->name eq 'Blue', "Fetch many to many 1 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', share_db => 1, with_objects => [ 'other_obj', 'bb2', 'nicks', 'bb1', 'colors' ], multi_many_ok => 1, with_map_records => 'map_record', query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); is(ref $objs, 'ARRAY', "get_objects() with many to many 1 - $db_type"); $objs ||= []; is(scalar @$objs, 3, "get_objects() with many to many 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() with many to many 3 - $db_type"); is($objs->[1]->id, 2, "get_objects() with many to many 4 - $db_type"); is($objs->[2]->id, 1, "get_objects() with many to many 5 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many to many 6 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many to many 7 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many to many 8 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many to many 9 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many to many 10 - $db_type"); $fo1 = $objs->[0]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects() with many to many 11 - $db_type"); $fo1 = $objs->[0]->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects() with many to many 12 - $db_type"); my $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() with many to many 13 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() with many to many 14 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects() with many to many 15 - $db_type"); is($colors->[0]->map_record->color_id, $colors->[0]->id, "map_record 1 - $db_type"); is($colors->[0]->map_record->object_id, $objs->[1]->id, "map_record 2 - $db_type"); is($colors->[1]->map_record->color_id, $colors->[1]->id, "map_record 3 - $db_type"); is($colors->[0]->map_record->object_id, $objs->[1]->id, "map_record 4 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyInformixObject', share_db => 1, with_objects => [ 'other_obj', 'bb2', 'nicks', 'bb1', 'colors' ], multi_many_ok => 1, with_map_records => 'map_record', query => [ id => [ 1, 2, 5 ] ], sort_by => 't1.name'); $objs = []; while(my $obj = $iterator->next) { push(@$objs, $obj); } is(ref $objs, 'ARRAY', "get_objects_iterator() with many to many map record 1 - $db_type"); is(scalar @$objs, 3, "get_objects_iterator() with many to many map record 2 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db is($colors->[0]->map_record->color_id, $colors->[0]->id, "map_record 5 - $db_type"); is($colors->[0]->map_record->object_id, $objs->[1]->id, "map_record 6 - $db_type"); is($colors->[1]->map_record->color_id, $colors->[1]->id, "map_record 7 - $db_type"); is($colors->[0]->map_record->object_id, $objs->[1]->id, "map_record 8 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', share_db => 1, with_objects => [ 'other_obj', 'bb2', 'nicks', 'bb1', 'colors' ], multi_many_ok => 1, with_map_records => 'map_rec', query => [ id => [ 1, 2, 5 ] ], sort_by => 't1.name'); is(ref $objs, 'ARRAY', "get_objects() with many to many 1 - $db_type"); $objs ||= []; is(scalar @$objs, 3, "get_objects() with many to many 2 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db is($colors->[0]->map_rec->color_id, $colors->[0]->id, "map_rec 1 - $db_type"); is($colors->[0]->map_rec->object_id, $objs->[1]->id, "map_rec 2 - $db_type"); is($colors->[1]->map_rec->color_id, $colors->[1]->id, "map_rec 3 - $db_type"); is($colors->[0]->map_rec->object_id, $objs->[1]->id, "map_rec 4 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', share_db => 1, with_objects => [ 'bb1', 'nicks', 'other_obj', 'colors', 'bb2' ], multi_many_ok => 1, query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); is(ref $objs, 'ARRAY', "get_objects() with many to many (reorder) 1 - $db_type"); $objs ||= []; is(scalar @$objs, 3, "get_objects() with many to many (reorder) 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() with many to many (reorder) 3 - $db_type"); is($objs->[1]->id, 2, "get_objects() with many to many (reorder) 4 - $db_type"); is($objs->[2]->id, 1, "get_objects() with many to many (reorder) 5 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many to many (reorder) 6 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many to many (reorder) 7 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many to many (reorder) 8 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many to many (reorder) 9 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many to many (reorder) 10 - $db_type"); $fo1 = $objs->[0]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects() with many to many (reorder) 11 - $db_type"); $fo1 = $objs->[0]->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects() with many to many (reorder) 12 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() with many to many (reorder) 13 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() with many to many (reorder) 14 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects() with many to many (reorder) 15 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', share_db => 1, with_objects => [ 'nicks', 'colors', 'bb2' ], multi_many_ok => 1, require_objects => [ 'bb1', 'other_obj' ], query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); is(ref $objs, 'ARRAY', "get_objects() with many to many require with 1 - $db_type"); $objs ||= []; is(scalar @$objs, 2, "get_objects() with many to many require with 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() with many to many require with 3 - $db_type"); is($objs->[1]->id, 2, "get_objects() with many to many require with 4 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many to many require with 6 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many to many 7 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many to many 8 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many to many 9 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many to many 10 - $db_type"); $fo1 = $objs->[0]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects() with many to many require with 11 - $db_type"); $fo1 = $objs->[0]->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects() with many to many require with 12 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() with many to many require with 13 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() with many to many require with 14 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects() with many to many require with 15 - $db_type"); $fo1 = $objs->[1]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'two', "get_objects() with many to many require with 16 - $db_type"); $fo1 = $objs->[0]->{'other_obj'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'Foo 1', "get_objects() with many to many require with 17 - $db_type"); $fo1 = $objs->[1]->{'other_obj'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'Foo 2', "get_objects() with many to many require with 18 - $db_type"); ok(!defined $objs->[0]->{'colors'}, "get_objects() with many to many require with 19 - $db_type"); ok(!defined $objs->[1]->{'bb2'}, "get_objects() with many to many require with 20 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyInformixObject', share_db => 1, with_objects => [ 'other_obj', 'bb2', 'nicks', 'bb1', 'colors' ], multi_many_ok => 1, query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); $o = $iterator->next; is($o->name, 'Betty', "get_objects_iterator() with many to many 1 - $db_type"); is($o->id, 5, "get_objects_iterator() with many to many 2 - $db_type"); $nicks = $o->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects_iterator() with many to many 3 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects_iterator() with many to many 4 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects_iterator() with many to many 5 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects_iterator() with many to many 6 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects_iterator() with many to many 7 - $db_type"); $fo1 = $o->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects_iterator() with many to many 8 - $db_type"); $fo1 = $o->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects_iterator() with many to many 9 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "get_objects_iterator() with many to many 10 - $db_type"); is($o->id, 2, "get_objects_iterator() with many to many 11 - $db_type"); $colors = $o->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects_iterator() with many to many 12 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many 13 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many 14 - $db_type"); $o = $iterator->next; is($o->name, 'John', "get_objects_iterator() with many to many 15 - $db_type"); is($o->id, 1, "get_objects_iterator() with many to many 16 - $db_type"); $o = $iterator->next; is($o, 0, "get_objects_iterator() with many to many 17 - $db_type"); is($iterator->total, 3, "get_objects_iterator() with many to many 18 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyInformixObject', share_db => 1, with_objects => [ 'bb1', 'nicks', 'other_obj', 'colors', 'bb2' ], multi_many_ok => 1, query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); $o = $iterator->next; is($o->name, 'Betty', "get_objects_iterator() with many to many 19 - $db_type"); is($o->id, 5, "get_objects_iterator() with many to many 20 - $db_type"); $nicks = $o->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects_iterator() with many to many 21 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects_iterator() with many to many 22 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects_iterator() with many to many 23 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects_iterator() with many to many 24 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects_iterator() with many to many 25 - $db_type"); $fo1 = $o->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects_iterator() with many to many 26 - $db_type"); $fo1 = $o->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects_iterator() with many to many 27 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "get_objects_iterator() with many to many 28 - $db_type"); is($o->id, 2, "get_objects_iterator() with many to many 29 - $db_type"); $colors = $o->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects_iterator() with many to many 30 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many 31 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many 32 - $db_type"); $o = $iterator->next; is($o->name, 'John', "get_objects_iterator() with many to many 33 - $db_type"); is($o->id, 1, "get_objects_iterator() with many to many 34 - $db_type"); $o = $iterator->next; is($o, 0, "get_objects_iterator() with many to many 35 - $db_type"); is($iterator->total, 3, "get_objects_iterator() with many to many 36 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyInformixObject', share_db => 1, with_objects => [ 'nicks', 'colors', 'bb2' ], multi_many_ok => 1, require_objects => [ 'bb1', 'other_obj' ], query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); $o = $iterator->next; is($o->name, 'Betty', "get_objects_iterator() with many to many require 1 - $db_type"); is($o->id, 5, "get_objects_iterator() with many to many require 2 - $db_type"); $fo1 = $o->{'other_obj'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'Foo 1', "get_objects_iterator() with many to many require 3 - $db_type"); ok(!defined $o->{'colors'}, "get_objects_iterator() with many to many require 4 - $db_type"); $nicks = $o->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects_iterator() with many to many require 5 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects_iterator() with many to many require 6 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects_iterator() with many to many require 7 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects_iterator() with many to many require 8 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects_iterator() with many to many require 9 - $db_type"); $fo1 = $o->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects_iterator() with many to many require 10 - $db_type"); $fo1 = $o->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects_iterator() with many to many require 11 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "get_objects_iterator() with many to many require 12 - $db_type"); is($o->id, 2, "get_objects_iterator() with many to many require 13 - $db_type"); $colors = $o->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects_iterator() with many to many require 14 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many require 15 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many require 16 - $db_type"); $fo1 = $o->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'two', "get_objects_iterator() with many to many require 17 - $db_type"); $fo1 = $o->{'other_obj'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'Foo 2', "get_objects_iterator() with many to many require 18 - $db_type"); ok(!defined $o->{'bb2'}, "get_objects_iterator() with many to many require 19 - $db_type"); $o = $iterator->next; is($o, 0, "get_objects_iterator() with many to many require 20 - $db_type"); is($iterator->total, 2, "get_objects_iterator() with many to many require 21 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyInformixObject', share_db => 1, with_objects => [ 'nicks', 'colors', 'bb2' ], multi_many_ok => 1, require_objects => [ 'bb1', 'other_obj' ], query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name', limit => 1, offset => 5); ok(!$iterator->next, "get_objects_iterator() with many to many require 22 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', share_db => 1, with_objects => [ 'nicks', 'colors', 'bb2' ], multi_many_ok => 1, require_objects => [ 'bb1', 'other_obj' ], query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name', limit => 1, offset => 5); ok(@$objs == 0, "get_objects_iterator() with many to many require 23 - $db_type"); # End "many to many" tests # Start multi-require tests $fo = MyInformixColorMap->new(id => 3, object_id => 5, color_id => 2); $fo->save; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', share_db => 1, require_objects => [ 'nicks', 'colors', 'other_obj' ], multi_many_ok => 1, sort_by => 't1.name'); is(scalar @$objs, 2, "get_objects() multi many require 1 - $db_type"); is($objs->[0]->id, 5, "get_objects() multi many require 2 - $db_type"); is($objs->[1]->id, 2, "get_objects() multi many require 3 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() multi many require 4 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() multi many require 5 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() multi many require 6 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() multi many require 7 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() multi many require 8 - $db_type"); $colors = $objs->[0]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 1, "get_objects() multi many require 9 - $db_type"); ok($colors->[0]->id == 2 && $colors->[0]->name eq 'Green', "get_objects() multi many require 10 - $db_type"); $nicks = $objs->[1]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 2, "get_objects() multi many require 11 - $db_type"); is($nicks->[0]->nick, 'ntwo', "get_objects() multi many require 12 - $db_type"); is($nicks->[1]->nick, 'nfour', "get_objects() multi many require 13 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() multi many require 14 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() multi many require 15 - $db_type"); ok($colors->[1]->id == 3 && $colors->[1]->name eq 'Blue', "get_objects() multi many require 16 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', share_db => 1, require_objects => [ 'nicks', 'colors', 'other_obj' ], with_objects => [ 'bb2' ], multi_many_ok => 1, sort_by => 't1.name'); is(scalar @$objs, 2, "get_objects() multi many with require 1 - $db_type"); is($objs->[0]->id, 5, "get_objects() multi many with require 2 - $db_type"); is($objs->[1]->id, 2, "get_objects() multi many with require 3 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() multi many with require 4 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() multi many with require 5 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() multi many with require 6 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() multi many with require 7 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() multi many with require 8 - $db_type"); $colors = $objs->[0]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 1, "get_objects() multi many with require 9 - $db_type"); ok($colors->[0]->id == 2 && $colors->[0]->name eq 'Green', "get_objects() multi many with require 10 - $db_type"); $nicks = $objs->[1]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 2, "get_objects() multi many with require 11 - $db_type"); is($nicks->[0]->nick, 'ntwo', "get_objects() multi many with require 12 - $db_type"); is($nicks->[1]->nick, 'nfour', "get_objects() multi many with require 13 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() multi many with require 14 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() multi many with require 15 - $db_type"); ok($colors->[1]->id == 3 && $colors->[1]->name eq 'Blue', "get_objects() multi many with require 16 - $db_type"); is($objs->[0]->{'bb2'}{'name'}, 'four', "get_objects() multi many with require 17 - $db_type"); ok(!defined $objs->[1]->{'bb2'}{'name'}, "get_objects() multi many with require 18 - $db_type"); MyInformixNick->new(id => 7, o_id => 10, nick => 'nseven')->save; MyInformixNick->new(id => 8, o_id => 11, nick => 'neight')->save; MyInformixNick->new(id => 9, o_id => 12, nick => 'nnine')->save; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', share_db => 1, require_objects => [ 'nicks', 'bb1' ], with_objects => [ 'colors' ], multi_many_ok => 1, sort_by => 't1.name'); is(scalar @$objs, 5, "get_objects() multi many with require map 1 - $db_type"); is($objs->[0]->id, 5, "get_objects() multi many with require map 2 - $db_type"); is($objs->[1]->id, 10, "get_objects() multi many with require map 3 - $db_type"); is($objs->[2]->id, 11, "get_objects() multi many with require map 4 - $db_type"); is($objs->[3]->id, 12, "get_objects() multi many with require map 5 - $db_type"); is($objs->[4]->id, 2, "get_objects() multi many with require map 6 - $db_type"); # End multi-require tests # Start distinct tests my $i = 0; # Can't do this in Informix thanks to the "nums" SET column: # Error -9607 Collections are not allowed in the DISTINCT clause. #foreach my $distinct (1, [ 't1' ], [ 'rose_db_object_test' ]) #{ # $i++; # # $objs = # Rose::DB::Object::Manager->get_objects( # object_class => 'MyInformixObject', # distinct => $distinct, # share_db => 1, # require_objects => [ 'nicks', 'colors', 'other_obj' ], # multi_many_ok => 1, # sort_by => 't1.name'); # # is(scalar @$objs, 2, "get_objects() distinct multi many require $i.1 - $db_type"); # # is($objs->[0]->id, 5, "get_objects() distinct multi many require $i.2 - $db_type"); # is($objs->[1]->id, 2, "get_objects() distinct multi many require $i.3 - $db_type"); # # ok(!defined $objs->[0]->{'nicks'}, "get_objects() distinct multi many require $i.4 - $db_type"); # ok(!defined $objs->[0]->{'colors'}, "get_objects() distinct multi many require $i.5 - $db_type"); # # ok(!defined $objs->[1]->{'nicks'}, "get_objects() distinct multi many require $i.6 - $db_type"); # ok(!defined $objs->[1]->{'colors'}, "get_objects() distinct multi many require $i.7 - $db_type"); #} #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; # Can't do this in Informix thanks to the "nums" SET column: # Error -9607 Collections are not allowed in the DISTINCT clause. #foreach my $distinct ([ 't2' ], [ 'rose_db_object_nicks' ], [ 'nicks' ]) #{ # $i++; # # $objs = # Rose::DB::Object::Manager->get_objects( # object_class => 'MyInformixObject', # distinct => $distinct, # share_db => 1, # require_objects => [ 'nicks', 'colors', 'other_obj' ], # multi_many_ok => 1, # sort_by => 't1.name'); # # is(scalar @$objs, 2, "get_objects() distinct multi many require $i.1 - $db_type"); # # is($objs->[0]->id, 5, "get_objects() distinct multi many require $i.2 - $db_type"); # is($objs->[1]->id, 2, "get_objects() distinct multi many require $i.3 - $db_type"); # # ok(defined $objs->[0]->{'nicks'}, "get_objects() distinct multi many require $i.4 - $db_type"); # ok(!defined $objs->[0]->{'colors'}, "get_objects() distinct multi many require $i.5 - $db_type"); # # ok(defined $objs->[1]->{'nicks'}, "get_objects() distinct multi many require $i.6 - $db_type"); # ok(!defined $objs->[1]->{'colors'}, "get_objects() distinct multi many require $i.7 - $db_type"); #} # End distinct tests # Start pager tests is(Rose::DB::Object::Manager->default_objects_per_page, 20, 'default_objects_per_page 1'); Rose::DB::Object::Manager->default_objects_per_page(3); my $per_page = Rose::DB::Object::Manager->default_objects_per_page; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 1, per_page => 3); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 1.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 1); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 2.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', query => [ id => { le => 11 } ], sort_by => 't1.id', per_page => 3); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 3.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', query => [ id => { le => 11 } ], sort_by => 't1.id', per_page => -1); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 4.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => -1); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 5.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => undef); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 6.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', query => [ id => { le => 11 } ], sort_by => 't1.id', per_page => undef); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 7.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', query => [ id => { le => 11 } ], sort_by => 't1.id'); ok(scalar @$objs > 3, "pager 8 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 2, per_page => 3); $i = 0; for(4 .. 6) { is($objs->[$i++]->id, $_, "pager 9.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 3, per_page => 3); $i = 0; for(7 .. 9) { is($objs->[$i++]->id, $_, "pager 10.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 4, per_page => 3); $i = 0; for(10 .. 11) { is($objs->[$i++]->id, $_, "pager 11.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 5, per_page => 3); ok(scalar @$objs == 0, "pager 12 - $db_type"); Rose::DB::Object::Manager->default_objects_per_page(20); # End pager tests # Start get_objects_from_sql tests $objs = MyInformixObjectManager->get_objects_from_sql( db => MyInformixObject->init_db, object_class => 'MyInformixObject', prepare_cached => 1, sql => <<"EOF"); SELECT * FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF ok(scalar @$objs == 19, "get_objects_from_sql 1 - $db_type"); is($objs->[18]->id, 1, "get_objects_from_sql 2 - $db_type"); is($objs->[18]->save_col, 5, "get_objects_from_sql 3 - $db_type"); is($objs->[18]->name, 'John', "get_objects_from_sql 4 - $db_type"); $iterator = MyInformixObjectManager->get_objects_iterator_from_sql( db => MyInformixObject->init_db, object_class => 'MyInformixObject', prepare_cached => 1, sql => <<"EOF"); SELECT * FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF for(0 .. 17) { $iterator->next } $o = $iterator->next; is($o->id, 1, "get_objects_iterator_from_sql 1 - $db_type"); is($o->save_col, 5, "get_objects_iterator_from_sql 2 - $db_type"); is($o->name, 'John', "get_objects_iterator_from_sql 3 - $db_type"); ok(!$iterator->next, "get_objects_iterator_from_sql 4 - $db_type"); $objs = MyInformixObjectManager->get_objects_from_sql(<<"EOF"); SELECT * FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF ok(scalar @$objs == 19, "get_objects_from_sql 5 - $db_type"); is($objs->[18]->id, 1, "get_objects_from_sql 6 - $db_type"); is($objs->[18]->save_col, 5, "get_objects_from_sql 7 - $db_type"); is($objs->[18]->name, 'John', "get_objects_from_sql 8 - $db_type"); $objs = MyInformixObjectManager->get_objects_from_sql( args => [ 19 ], sql => <<"EOF"); SELECT * FROM rose_db_object_test WHERE id > ? ORDER BY id DESC EOF ok(scalar @$objs == 2, "get_objects_from_sql 9 - $db_type"); is($objs->[0]->id, 60, "get_objects_from_sql 10 - $db_type"); my $method = MyInformixObjectManager->make_manager_method_from_sql( get_em => <<"EOF"); SELECT *, save + fk1 AS extra FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF $objs = MyInformixObjectManager->get_em; ok(scalar @$objs == 19, "make_manager_method_from_sql 1 - $db_type"); is($objs->[17]->id, 3, "make_manager_method_from_sql 2 - $db_type"); is($objs->[17]->extra, 7, "make_manager_method_from_sql 3 - $db_type"); is($objs->[17]->name, 'Sue', "make_manager_method_from_sql 4 - $db_type"); $objs = $method->('MyInformixObjectManager'); ok(scalar @$objs == 19, "make_manager_method_from_sql 5 - $db_type"); is($objs->[17]->id, 3, "make_manager_method_from_sql 6 - $db_type"); is($objs->[17]->extra, 7, "make_manager_method_from_sql 7 - $db_type"); is($objs->[17]->name, 'Sue', "make_manager_method_from_sql 8 - $db_type"); $method = MyInformixObjectManager->make_manager_method_from_sql( iterator => 1, method => 'iter_em', sql => <<"EOF"); SELECT *, save + fk1 AS extra FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF $iterator = MyInformixObjectManager->iter_em; for(0 .. 16) { $iterator->next } $o = $iterator->next; is($objs->[17]->id, 3, "make_manager_method_from_sql iterator 1 - $db_type"); is($objs->[17]->extra, 7, "make_manager_method_from_sql iterator 2 - $db_type"); is($objs->[17]->name, 'Sue', "make_manager_method_from_sql iterator 3 - $db_type"); $iterator = $method->('MyInformixObjectManager'); for(0 .. 16) { $iterator->next } $o = $iterator->next; is($objs->[17]->id, 3, "make_manager_method_from_sql iterator 4 - $db_type"); is($objs->[17]->extra, 7, "make_manager_method_from_sql iterator 5 - $db_type"); is($objs->[17]->name, 'Sue', "make_manager_method_from_sql iterator 6 - $db_type"); $method = MyInformixObjectManager->make_manager_method_from_sql( get_more => <<"EOF"); SELECT *, save + fk1 AS extra FROM rose_db_object_test WHERE id > ? ORDER BY id DESC EOF $objs = MyInformixObjectManager->get_more(18); ok(scalar @$objs == 3, "make_manager_method_from_sql 9 - $db_type"); is($objs->[2]->id, 19, "make_manager_method_from_sql 10 - $db_type"); $method = MyInformixObjectManager->make_manager_method_from_sql( method => 'get_more_np', params => [ qw(id name) ], sql => <<"EOF"); SELECT *, save + fk1 AS extra FROM rose_db_object_test WHERE id > ? AND name != ? ORDER BY id DESC EOF $objs = MyInformixObjectManager->get_more_np(name => 'Nonesuch', id => 18); ok(scalar @$objs == 3, "make_manager_method_from_sql 11 - $db_type"); is($objs->[2]->id, 19, "make_manager_method_from_sql 12 - $db_type"); # End get_objects_from_sql tests # Start tough order tests $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', require_objects => [ 'nicks' ], nonlazy => 1); ok(@$objs == 5, "tough order 1 - $db_type"); is($objs->[0]->id, 2, "tough order 2 - $db_type"); is($objs->[1]->id, 5, "tough order 3 - $db_type"); is($objs->[2]->id, 10, "tough order 4 - $db_type"); is($objs->[3]->id, 11, "tough order 5 - $db_type"); is($objs->[4]->id, 12, "tough order 6 - $db_type"); is($objs->[0]{'nicks'}[0]{'nick'}, 'ntwo', "tough order 7 - $db_type"); is($objs->[0]{'nicks'}[1]{'nick'}, 'nfour', "tough order 8 - $db_type"); is($objs->[1]{'nicks'}[0]{'nick'}, 'nthree', "tough order 9 - $db_type"); is($objs->[1]{'nicks'}[1]{'nick'}, 'nsix', "tough order 10 - $db_type"); is($objs->[1]{'nicks'}[2]{'nick'}, 'none', "tough order 11 - $db_type"); is($objs->[1]{'nicks'}[3]{'nick'}, 'nfive', "tough order 12 - $db_type"); is($objs->[2]{'nicks'}[0]{'nick'}, 'nseven', "tough order 13 - $db_type"); is($objs->[3]{'nicks'}[0]{'nick'}, 'neight', "tough order 14 - $db_type"); is($objs->[4]{'nicks'}[0]{'nick'}, 'nnine', "tough order 15 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', require_objects => [ 'nicks' ], nonlazy => 1, sort_by => 'name'); ok(@$objs == 5, "tough order 16 - $db_type"); is($objs->[0]->id, 5, "tough order 17 - $db_type"); is($objs->[1]->id, 10, "tough order 18 - $db_type"); is($objs->[2]->id, 11, "tough order 19 - $db_type"); is($objs->[3]->id, 12, "tough order 20 - $db_type"); is($objs->[4]->id, 2, "tough order 21 - $db_type"); is($objs->[0]{'nicks'}[0]{'nick'}, 'nthree', "tough order 22 - $db_type"); is($objs->[0]{'nicks'}[1]{'nick'}, 'nsix', "tough order 23 - $db_type"); is($objs->[0]{'nicks'}[2]{'nick'}, 'none', "tough order 24 - $db_type"); is($objs->[0]{'nicks'}[3]{'nick'}, 'nfive', "tough order 25 - $db_type"); is(scalar @{$objs->[0]{'nicks'}}, 4, "tough order 26 - $db_type"); is($objs->[1]{'nicks'}[0]{'nick'}, 'nseven', "tough order 27 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 1, "tough order 28 - $db_type"); is($objs->[2]{'nicks'}[0]{'nick'}, 'neight', "tough order 29 - $db_type"); is(scalar @{$objs->[2]{'nicks'}}, 1, "tough order 30 - $db_type"); is($objs->[3]{'nicks'}[0]{'nick'}, 'nnine', "tough order 31 - $db_type"); is(scalar @{$objs->[3]{'nicks'}}, 1, "tough order 32 - $db_type"); is($objs->[4]{'nicks'}[0]{'nick'}, 'ntwo', "tough order 33 - $db_type"); is($objs->[4]{'nicks'}[1]{'nick'}, 'nfour', "tough order 34 - $db_type"); is(scalar @{$objs->[4]{'nicks'}}, 2, "tough order 35 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyInformixObject', require_objects => [ 'nicks' ], nonlazy => 1, sort_by => 'name'); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'nthree', "tough order 36 - $db_type"); is($o->{'nicks'}[1]{'nick'}, 'nsix', "tough order 37 - $db_type"); is($o->{'nicks'}[2]{'nick'}, 'none', "tough order 38 - $db_type"); is($o->{'nicks'}[3]{'nick'}, 'nfive', "tough order 39 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "tough order 40 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'nseven', "tough order 41 - $db_type"); is(scalar @{$o->{'nicks'}}, 1, "tough order 42 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'neight', "tough order 43 - $db_type"); is(scalar @{$o->{'nicks'}}, 1, "tough order 44 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'nnine', "tough order 45 - $db_type"); is(scalar @{$o->{'nicks'}}, 1, "tough order 46 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'ntwo', "tough order 47 - $db_type"); is($o->{'nicks'}[1]{'nick'}, 'nfour', "tough order 48 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "tough order 49 - $db_type"); ok(!$iterator->next, "tough order 50 - $db_type"); is($iterator->total, 5, "tough order 51 - $db_type"); # End tough order tests # Start deep join tests eval { Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', require_objects => [ 'nicks.type' ], with_objects => [ 'nicks.type' ]); }; ok($@, "deep join conflict 1 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', require_objects => [ 'nicks.type', 'nicks.type', 'nicks' ], with_objects => [ 'nicks.type.t2', 'nicks.alts' ], multi_many_ok => 1, query => [ 'id' => [ 2, 5 ] ], sort_by => 'type.name'); ok(@$objs == 2, "deep join 1 - $db_type"); is($objs->[0]->id, 2, "deep join 2 - $db_type"); is($objs->[1]->id, 5, "deep join 3 - $db_type"); is($objs->[0]{'nicks'}[0]{'type'}{'name'}, 'nt four', "deep join 4 - $db_type"); is($objs->[0]{'nicks'}[1]{'type'}{'name'}, 'nt two', "deep join 5 - $db_type"); is(scalar @{$objs->[0]{'nicks'}}, 2, "deep join 6 - $db_type"); is($objs->[1]{'nicks'}[0]{'type'}{'name'}, 'nt five', "deep join 7 - $db_type"); is($objs->[1]{'nicks'}[1]{'type'}{'name'}, 'nt one', "deep join 8 - $db_type"); is($objs->[1]{'nicks'}[2]{'type'}{'name'}, 'nt six', "deep join 9 - $db_type"); is($objs->[1]{'nicks'}[3]{'type'}{'name'}, 'nt three', "deep join 10 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 4, "deep join 11 - $db_type"); is($objs->[0]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join 12 - $db_type"); is($objs->[0]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join 13 - $db_type"); is($objs->[0]{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt two 1', "deep join 14 - $db_type"); $objs->[1]{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$objs->[1]{'nicks'}[1]{'alts'}} ]; is($objs->[1]{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt one 1', "deep join 15 - $db_type"); is($objs->[1]{'nicks'}[1]{'alts'}[1]{'alt'}, 'alt one 2', "deep join 16 - $db_type"); is($objs->[1]{'nicks'}[1]{'alts'}[2]{'alt'}, 'alt one 3', "deep join 17 - $db_type"); is(scalar @{$objs->[1]{'nicks'}[1]{'alts'}}, 3, "deep join 18 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', with_objects => [ 'nicks.type' ], nonlazy => 1, sort_by => 'type.name'); ok(@$objs == 21, "deep join with 1 - $db_type"); is($objs->[0]->id, 1, "deep join with 2 - $db_type"); is($objs->[1]->id, 2, "deep join with 3 - $db_type"); is($objs->[2]->id, 3, "deep join with 4 - $db_type"); is($objs->[16]->id, 17, "deep join with 5 - $db_type"); #SORT: #{ # $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; #} is($objs->[1]{'nicks'}[0]{'type'}{'name'}, 'nt four', "deep join with 6 - $db_type"); is($objs->[1]{'nicks'}[1]{'type'}{'name'}, 'nt two', "deep join with 7 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 2, "deep join with 8 - $db_type"); #SORT: #{ # $objs->[4]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[4]{'nicks'}} ]; #} is($objs->[4]{'nicks'}[0]{'type'}{'name'}, 'nt five', "deep join with 9 - $db_type"); is($objs->[4]{'nicks'}[1]{'type'}{'name'}, 'nt one', "deep join with 10 - $db_type"); is($objs->[4]{'nicks'}[2]{'type'}{'name'}, 'nt six', "deep join with 11 - $db_type"); is($objs->[4]{'nicks'}[3]{'type'}{'name'}, 'nt three', "deep join with 12 - $db_type"); is(scalar @{$objs->[4]{'nicks'}}, 4, "deep join with 13 - $db_type"); is(scalar @{$objs->[0]{'nicks'} ||= []}, 0, "deep join with 14 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyInformixObject', require_objects => [ 'nicks.type', 'nicks.type', 'nicks' ], with_objects => [ 'nicks.type.t2', 'nicks.alts' ], multi_many_ok => 1, query => [ 'id' => [ 2, 5 ] ], sort_by => 'type.name'); $o = $iterator->next; is($o->{'nicks'}[0]{'type'}{'name'}, 'nt four', "deep join iterator 1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'name'}, 'nt two', "deep join iterator 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "deep join iterator 3 - $db_type"); is($o->{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt two 1', "deep join 3.1 - $db_type"); is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join iterator 3.1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join iterator 3.2 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'type'}{'name'}, 'nt five', "deep join iterator 4 - $db_type"); is($o->{'nicks'}[1]{'type'}{'name'}, 'nt one', "deep join iterator 5 - $db_type"); is($o->{'nicks'}[2]{'type'}{'name'}, 'nt six', "deep join iterator 6 - $db_type"); is($o->{'nicks'}[3]{'type'}{'name'}, 'nt three', "deep join iterator 7 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "deep join iterator 8 - $db_type"); $o->{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$o->{'nicks'}[1]{'alts'}} ]; is($o->{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt one 1', "deep join iterator 9 - $db_type"); is($o->{'nicks'}[1]{'alts'}[1]{'alt'}, 'alt one 2', "deep join iterator 10 - $db_type"); is($o->{'nicks'}[1]{'alts'}[2]{'alt'}, 'alt one 3', "deep join iterator 11 - $db_type"); is(scalar @{$o->{'nicks'}[1]{'alts'}}, 3, "deep join iterator 12 - $db_type"); ok(!$iterator->next, "deep join iterator 13 - $db_type"); is($iterator->total, 2, "deep join iterator 14 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyInformixObject', with_objects => [ 'nicks.type' ], nonlazy => 1, sort_by => 'type.name'); $o = $iterator->next; is($o->id, 1, "deep join with with iterator 1 - $db_type"); $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; #} is($o->{'nicks'}[0]{'type'}{'name'}, 'nt four', "deep join with with iterator 1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'name'}, 'nt two', "deep join with iterator 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "deep join with iterator 3 - $db_type"); $o = $iterator->next; $o = $iterator->next; $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; #} is($o->{'nicks'}[0]{'type'}{'name'}, 'nt five', "deep join with iterator 4 - $db_type"); is($o->{'nicks'}[1]{'type'}{'name'}, 'nt one', "deep join with iterator 5 - $db_type"); is($o->{'nicks'}[2]{'type'}{'name'}, 'nt six', "deep join with iterator 6 - $db_type"); is($o->{'nicks'}[3]{'type'}{'name'}, 'nt three', "deep join with iterator 7 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "deep join with iterator 8 - $db_type"); while($iterator->next) { } is($iterator->total, 21, "deep join iterator 9 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', require_objects => [ 'nicks.type.t2' ], query => [ 'id' => [ 2, 5 ] ], nonlazy => 1, sort_by => 'type.name'); ok(@$objs == 2, "deep join three-level 1 - $db_type"); is($objs->[0]->id, 2, "deep join three-level 2 - $db_type"); is($objs->[1]->id, 5, "deep join three-level 3 - $db_type"); #SORT: #{ # $objs->[0]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[0]{'nicks'}} ]; #} is($objs->[0]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join three-level 4 - $db_type"); is($objs->[0]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join three-level 5 - $db_type"); is(scalar @{$objs->[0]{'nicks'}}, 2, "deep join three-level 6 - $db_type"); #SORT: #{ # $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; #} is($objs->[1]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 five', "deep join three-level 7 - $db_type"); is($objs->[1]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 one', "deep join three-level 8 - $db_type"); is($objs->[1]{'nicks'}[2]{'type'}{'t2'}{'name'}, 'nt2 six', "deep join three-level 9 - $db_type"); is($objs->[1]{'nicks'}[3]{'type'}{'t2'}{'name'}, 'nt2 three', "deep join three-level 10 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 4, "deep join three-level 11 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', with_objects => [ 'nicks.type.t2' ], nonlazy => 1, sort_by => 'type.name'); ok(@$objs == 21, "deep join three-level 1 - $db_type"); is($objs->[0]->id, 1, "deep join three-level 2 - $db_type"); is($objs->[1]->id, 2, "deep join three-level 3 - $db_type"); is($objs->[4]->id, 5, "deep join three-level 4 - $db_type"); is($objs->[20]->id, 60, "deep join three-level 5 - $db_type"); #SORT: #{ # $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; #} is($objs->[1]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join three-level 6 - $db_type"); is($objs->[1]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join three-level 7 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 2, "deep join three-level 8 - $db_type"); #SORT: #{ # $objs->[4]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[4]{'nicks'}} ]; #} is($objs->[4]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 five', "deep join three-level 9 - $db_type"); is($objs->[4]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 one', "deep join three-level 10 - $db_type"); is($objs->[4]{'nicks'}[2]{'type'}{'t2'}{'name'}, 'nt2 six', "deep join three-level 11 - $db_type"); is($objs->[4]{'nicks'}[3]{'type'}{'t2'}{'name'}, 'nt2 three', "deep join three-level 12 - $db_type"); is(scalar @{$objs->[4]{'nicks'}}, 4, "deep join three-level 13 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyInformixObject', require_objects => [ 'nicks.type.t2' ], query => [ 'id' => [ 2, 5 ] ], sort_by => 'type.name'); $o = $iterator->next; is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join iterator 1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join iterator 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "deep join iterator 3 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 five', "deep join iterator 4 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 one', "deep join iterator 5 - $db_type"); is($o->{'nicks'}[2]{'type'}{'t2'}{'name'}, 'nt2 six', "deep join iterator 6 - $db_type"); is($o->{'nicks'}[3]{'type'}{'t2'}{'name'}, 'nt2 three', "deep join iterator 7 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "deep join iterator 8 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyInformixObject', with_objects => [ 'nicks.type.t2' ], nonlazy => 1, sort_by => 'type.name'); $o = $iterator->next; $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; #} is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join iterator with 1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join iterator with 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "deep join iterator with 3 - $db_type"); $o = $iterator->next; $o = $iterator->next; $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; #} is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 five', "deep join iterator with 4 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 one', "deep join iterator with 5 - $db_type"); is($o->{'nicks'}[2]{'type'}{'t2'}{'name'}, 'nt2 six', "deep join iterator with 6 - $db_type"); is($o->{'nicks'}[3]{'type'}{'t2'}{'name'}, 'nt2 three', "deep join iterator with 7 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "deep join iterator with 8 - $db_type"); while($iterator->next) { } is($iterator->total, 21, "deep join iterator with 9 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', require_objects => [ 'nicks.alts' ], multi_many_ok => 1, query => [ 'id' => [ 2, 5 ] ], sort_by => 'alts.alt'); ok(@$objs == 2, "deep join multi 1 - $db_type"); is($objs->[0]->id, 2, "deep join multi 2 - $db_type"); is($objs->[1]->id, 5, "deep join multi 3 - $db_type"); is($objs->[0]{'nicks'}[0]{'alts'}[0]{'alt'}, 'alt two 1', "deep join multi 4 - $db_type"); is(scalar @{$objs->[0]{'nicks'}[0]{'alts'}}, 1, "deep join multi 5 - $db_type"); is($objs->[1]{'nicks'}[0]{'alts'}[0]{'alt'}, 'alt one 1', "deep join multi 6 - $db_type"); is($objs->[1]{'nicks'}[0]{'alts'}[1]{'alt'}, 'alt one 2', "deep join multi 7 - $db_type"); is($objs->[1]{'nicks'}[0]{'alts'}[2]{'alt'}, 'alt one 3', "deep join multi 8 - $db_type"); is(scalar @{$objs->[1]{'nicks'}[0]{'alts'}}, 3, "deep join multi 11 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', with_objects => [ 'nicks.alts' ], multi_many_ok => 1, nonlazy => 1, sort_by => 'alts.alt'); ok(@$objs == 21, "deep join multi with 1 - $db_type"); is($objs->[1]->id, 2, "deep join multi with 2 - $db_type"); is($objs->[4]->id, 5, "deep join multi with 3 - $db_type"); #SORT: #{ # $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; # $objs->[1]{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$objs->[1]{'nicks'}[1]{'alts'}} ]; #} is($objs->[1]{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt two 1', "deep join multi with with 4 - $db_type"); is(scalar @{$objs->[1]{'nicks'}[1]{'alts'}}, 1, "deep join multi with 5 - $db_type"); #SORT: #{ # $objs->[4]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[4]{'nicks'}} ]; # $objs->[4]{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$objs->[4]{'nicks'}[3]{'alts'}} ]; #} is($objs->[4]{'nicks'}[3]{'alts'}[0]{'alt'}, 'alt one 1', "deep join multi with 6 - $db_type"); is($objs->[4]{'nicks'}[3]{'alts'}[1]{'alt'}, 'alt one 2', "deep join multi with 7 - $db_type"); is($objs->[4]{'nicks'}[3]{'alts'}[2]{'alt'}, 'alt one 3', "deep join multi with 8 - $db_type"); is(scalar @{$objs->[4]{'nicks'}[3]{'alts'}}, 3, "deep join multi with 11 - $db_type"); is(scalar @{$objs->[0]{'nicks'} || []}, 0, "deep join multi with 12 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyInformixObject', require_objects => [ 'nicks.alts' ], multi_many_ok => 1, query => [ 'id' => [ 2, 5 ] ], sort_by => 'alts.alt'); $o = $iterator->next; is($o->id, 2, "deep join multi iter 1 - $db_type"); is($o->{'nicks'}[0]{'alts'}[0]{'alt'}, 'alt two 1', "deep join multi iter 2 - $db_type"); is(scalar @{$o->{'nicks'}[0]{'alts'}}, 1, "deep join multi iter 3 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'alts'}[0]{'alt'}, 'alt one 1', "deep join multi iter 4 - $db_type"); is($o->{'nicks'}[0]{'alts'}[1]{'alt'}, 'alt one 2', "deep join multi iter 5 - $db_type"); is($o->{'nicks'}[0]{'alts'}[2]{'alt'}, 'alt one 3', "deep join multi iter 6 - $db_type"); is(scalar @{$o->{'nicks'}[0]{'alts'}}, 3, "deep join multi iter 7 - $db_type"); ok(!$iterator->next, "deep join multi iter 8 - $db_type"); is($iterator->total, 2, "deep join multi iter 9 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyInformixObject', with_objects => [ 'nicks.alts' ], multi_many_ok => 1, nonlazy => 1, #query => [ id => 2 ], sort_by => 'alts.alt'); $o = $iterator->next; is(scalar @{$o->{'nicks'} ||= []}, 0, "deep join multi iter with 1 - $db_type"); $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; # $o->{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$o->{'nicks'}[1]{'alts'}} ]; #} is($o->id, 2, "deep join multi iter with 2 - $db_type"); is($o->{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt two 1', "deep join multi iter with 3 - $db_type"); is(scalar @{$o->{'nicks'}[1]{'alts'}}, 1, "deep join multi iter with 4 - $db_type"); $o = $iterator->next; $o = $iterator->next; $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; # $o->{'nicks'}[3]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$o->{'nicks'}[3]{'alts'}} ]; #} is($o->{'nicks'}[3]{'alts'}[0]{'alt'}, 'alt one 1', "deep join multi iter with 5 - $db_type"); is($o->{'nicks'}[3]{'alts'}[1]{'alt'}, 'alt one 2', "deep join multi iter with 6 - $db_type"); is($o->{'nicks'}[3]{'alts'}[2]{'alt'}, 'alt one 3', "deep join multi iter with 7 - $db_type"); is(scalar @{$o->{'nicks'}[3]{'alts'}}, 3, "deep join multi iter with 8 - $db_type"); while($iterator->next) { } is($iterator->total, 21, "deep join multi iter with 9 - $db_type"); # End deep join tests # Start custom select tests my @selects = ( 't2.nick, id, t2.id, name, UPPER(name) AS derived, fk1', 't1.id, t2.nick, t2.id, t1.name, UPPER(name) AS derived, t1.fk1', 'rose_db_object_nicks.id, rose_db_object_test.id, rose_db_object_nicks.nick, rose_db_object_test.name, UPPER(name) AS derived', [ \q(t1.id + 0 AS id), qw(name t2.nick nicks.id), \q(UPPER(name) AS derived) ], [ qw(t2.nick t2.id t1.id t1.name), 'UPPER(name) AS derived' ], [ \q(UPPER(name) AS derived), qw(t2.id rose_db_object_nicks.nick rose_db_object_test.id rose_db_object_test.name) ], [ qw(rose_db_object_test.id rose_db_object_nicks.nick rose_db_object_test.name rose_db_object_nicks.id), 'UPPER(name) AS derived' ], [ qw(rose_db_object_test.id rose_db_object_test.name rose_db_object_nicks.nick t2.id), 'UPPER(name) AS derived' ], ); $i = 0; #local $Rose::DB::Object::Manager::Debug = 1; foreach my $select (@selects) { $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyInformixObject', select => $select, require_objects => [ 'nicks' ], query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->nicks->[0]->nick && !defined $o->nicks->[0]->type_id && !defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->nicks->[0]->nick && !defined $o->nicks->[0]->type_id && !defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; ok(!$iterator->next, "custom select $i - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', select => $select, require_objects => [ 'nicks' ], query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; ok($objs->[0]->id > 2 && defined $objs->[0]->name && defined $objs->[0]->nicks->[0]->nick && !defined $objs->[0]->nicks->[0]->type_id && !defined $objs->[0]->flag2 && $objs->[0]->derived eq 'DERIVED: ' . uc($objs->[0]->name), "custom select $i - $db_type"); $i++; ok($objs->[1]->id > 2 && defined $objs->[1]->name && defined $objs->[1]->nicks->[0]->nick && !defined $objs->[1]->nicks->[0]->type_id && !defined $objs->[1]->flag2 && $objs->[1]->derived eq 'DERIVED: ' . uc($objs->[1]->name), "custom select $i - $db_type"); $i++; is(scalar @$objs, 2, "custom select $i - $db_type"); } @selects = ( 't2.nick, t1.*, t2.id, name, UPPER(name) AS derived', [ qw(t2.nick t2.id t1.*), 'UPPER(name) AS derived' ], ); #local $Rose::DB::Object::Manager::Debug = 1; foreach my $select (@selects) { $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyInformixObject', select => $select, require_objects => [ 'nicks' ], query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->nicks->[0]->nick && !defined $o->nicks->[0]->type_id && defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->nicks->[0]->nick && !defined $o->nicks->[0]->type_id && defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; ok(!$iterator->next, "custom select $i - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', select => $select, require_objects => [ 'nicks' ], query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; ok($objs->[0]->id > 2 && defined $objs->[0]->name && defined $objs->[0]->nicks->[0]->nick && !defined $objs->[0]->nicks->[0]->type_id && defined $objs->[0]->flag2 && $objs->[0]->derived eq 'DERIVED: ' . uc($objs->[0]->name), "custom select $i - $db_type"); $i++; ok($objs->[1]->id > 2 && defined $objs->[1]->name && defined $objs->[1]->nicks->[0]->nick && !defined $objs->[1]->nicks->[0]->type_id && defined $objs->[1]->flag2 && $objs->[1]->derived eq 'DERIVED: ' . uc($objs->[1]->name), "custom select $i - $db_type"); $i++; is(scalar @$objs, 2, "custom select $i - $db_type"); } @selects = ( '*, name, UPPER(name) AS derived', [ '*', 'UPPER(name) AS derived' ], ); #local $Rose::DB::Object::Manager::Debug = 1; foreach my $select (@selects) { $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyInformixObject', select => $select, query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; ok(!$iterator->next, "custom select $i - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyInformixObject', select => $select, query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; ok($objs->[0]->id > 2 && defined $objs->[0]->name && defined $objs->[0]->flag2 && $objs->[0]->derived eq 'DERIVED: ' . uc($objs->[0]->name), "custom select $i - $db_type"); $i++; ok($objs->[1]->id > 2 && defined $objs->[1]->name && defined $objs->[1]->flag2 && $objs->[1]->derived eq 'DERIVED: ' . uc($objs->[1]->name), "custom select $i - $db_type"); $i++; is(scalar @$objs, 2, "custom select $i - $db_type"); } # End custom select tests } # # SQLite # SKIP: foreach my $db_type (qw(sqlite)) { skip("SQLite tests", 794) unless($HAVE_SQLITE); Rose::DB->default_type($db_type); my($sql, $bind) = Rose::DB::Object::Manager->get_objects_sql( object_class => 'MySQLiteObject', where => [ name => { '@' => \q(xxx) }, start => { lt => \q(CURRENT_TIMESTAMP) }, ]); like($sql, qr/\bname @ xxx\b/, "strict_ops 1.0 - $db_type"); like($sql, qr/\bstart < CURRENT_TIMESTAMP\b/, "strict_ops 1.1 - $db_type"); eval { ($sql, $bind) = Rose::DB::Object::Manager->get_objects_sql( object_class => 'MySQLiteObject', strict_ops => 1, where => [ name => { '@' => \q(xxx) } ]); }; ok($@, "strict_ops 2 - $db_type"); Rose::DB::Object::Manager->strict_ops(1); eval { ($sql, $bind) = Rose::DB::Object::Manager->get_objects_sql( object_class => 'MySQLiteObject', where => [ name => { '@' => \q(xxx) } ]); }; ok($@, "strict_ops 3 - $db_type"); Rose::DB::Object::Manager->strict_ops(0); ($sql, $bind) = Rose::DB::Object::Manager->get_objects_sql( object_class => 'MySQLiteObject', where => [ name => { like => \q('%foo%') } ]); ok($sql =~ /name LIKE '%foo%'/, "scalar ref bind 1 - $db_type"); is(@$bind, 0, "scalar ref bind 2 - $db_type"); ($sql, $bind) = Rose::DB::Object::Manager->get_objects_sql( object_class => 'MySQLiteObject', require_objects => [ 'bb1' ], query => [ 'bb1.name' => { like => \q('%foo%') } ]); ok($sql =~ /name LIKE '%foo%'/, "scalar ref bind 3 - $db_type"); is(@$bind, 0, "scalar ref bind 4 - $db_type"); ($sql, $bind) = Rose::DB::Object::Manager->get_objects_sql( object_class => 'MySQLiteObject', require_objects => [ 'bb1' ], query => [ or => [ name => 'bar', 'bb1.name' => { like => \q('%foo%') }, ], ]); ok($sql =~ /t2\.name LIKE '%foo%'/, "scalar ref bind 5 - $db_type"); is(@$bind, 1, "scalar ref bind 6 - $db_type"); # Return ignored, just chaging arg validity my $xcount = MySQLiteObjectManager->object_count( share_db => 1, #debug => 1, require_objects => [ 'bb1' ], query => [ foo => { ne => 'xxx' }, 't2.x' => { like => 'o%' }, ]); my $o = MySQLiteObject->new(id => 1, name => 'John', flag => 't', flag2 => 'f', fkone => 2, status => 'active', bits => '00001', start => '2001-01-02', save_col => 5, nums => [ 1, 2, 3 ], last_modified => 'now', date_created => '2004-03-30 12:34:56'); ok($o->save, "object save() 1 - $db_type"); my $objs = MySQLiteObject->get_objectz( share_db => 1, #query_is_sql => 1, #debug => 1, query => [ id => { gt_lt => [ -1, 991 ] }, id => { gt_le => [ -1, 992 ] }, id => { ge_lt => [ -1, 993 ] }, id => { ge_le => [ -1, 994 ] }, id => { gt_lt_sql => [ -1, 991 ] }, id => { gt_le_sql => [ -1, 992 ] }, id => { ge_lt_sql => [ -1, 993 ] }, id => { ge_le_sql => [ -1, 994 ] }, id => { gt_lt => [ -1, \991 ] }, id => { gt_le => [ \-1, 992 ] }, id => { ge_lt => [ -1, \993 ] }, id => { ge_le => [ \-1, 994 ] }, id => { between => [ 0, 99 ] }, id => { between => [ 0, \q(101) ] }, id => { between => [ \1, 99 ] }, id => { ge => 1 }, id => { ne => undef }, fk3 => { eq => undef }, name => 'John', name => { field => 'LOWER(name)', eq => 'john' }, flag => 1, flag2 => 0, \q((1 = 1 and 5 > 2)), [ \q(fk1 > ?), 1 ], start => { le => \q(CURRENT_TIMESTAMP) }, start => { between => [ '1/1/1999', 'CURRENT_TIMESTAMP' ] }, start => { between_sql => [ "'1999-02-02'", 'CURRENT_TIMESTAMP' ] }, or => [ bits => '00001', \q((2 = 2 and 6 > 3)), save_col => [ 1, 5 ], and => [ status => 'active', [ \q(7 > ?), 3 ], ], ], status => 'active', bits => '00001', fixed => { like => 'nee%' }, or => [ and => [ '!bits' => '00001', bits => { ne => '11111' } ], and => [ bits => { lt => '10101' }, '!bits' => '10000' ] ], start => '2001-01-02', save_col => [ 1, 5 ], nums => '{1,2,3}', fk1 => 2, last_modified => { le => $o->db->format_timestamp(DateTime->now->add(days => 2)) }, date_created => '2004-03-30 12:34:56.000000000' ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => [ 'id', \q(LOWER(name)) ]); is(ref $objs, 'ARRAY', "get_objects() 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() 2 - $db_type"); my $o2 = $o->clone; $o2->id(2); $o2->name('Fred'); ok($o2->save, "object save() 2 - $db_type"); my $o3 = $o2->clone; $o3->id(3); $o3->name('Sue'); ok($o3->save, "object save() 3 - $db_type"); my $o4 = $o3->clone; $o4->id(4); $o4->name('Bob'); ok($o4->save, "object save() 4 - $db_type"); eval { $objs = MySQLiteObject->get_objectz( where => [ date_created => '205-1-2', # invalid date ]); }; ok($@, "Invalid date - $db_type"); eval { $objs = MySQLiteObject->get_objectz( where => [ flag => [] ]); }; ok($@, "Empty list 1 - $db_type"); $objs = MySQLiteObject->get_objectz( allow_empty_lists => 1, query => [ flag => [] ]); is(scalar @$objs, 4, "Empty list 2 - $db_type"); eval { $objs = MySQLiteObject->get_objectz( query => [ or => [ flag => 1, status => [] ] ]); }; ok($@, "Empty list 3 - $db_type"); $objs = MySQLiteObject->get_objectz( allow_empty_lists => 1, query => [ or => [ flag => 1, status => [] ] ]); is(scalar @$objs, 4, "Empty list 4 - $db_type"); $objs = MySQLiteObjectManager->get_objectz( share_db => 1, query_is_sql => 1, query => [ id => { ge => 2 }, name => { like => '%e%' }, flag => 1, flag2 => 0, status => 'active', bits => q(b'00001'), start => '2001-01-02', save => [ 1, 5 ], nums => '{1,2,3}', last_modified => { le => $o->db->format_timestamp(DateTime->now->add(days => 2)) }, date_created => '2004-03-30 12:34:56.000000000', status => { like => 'AC%', field => 'UPPER(status)' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'name DESC'); is(ref $objs, 'ARRAY', "get_objects() 3 - $db_type"); $objs ||= []; is(scalar @$objs, 2, "get_objects() 4 - $db_type"); is($objs->[0]->id, 3, "get_objects() 5 - $db_type"); is($objs->[1]->id, 2, "get_objects() 6 - $db_type"); my $count = MySQLiteObjectManager->object_count( share_db => 1, query_is_sql => 1, query => [ id => { ge => 2 }, name => { like => '%e%' }, flag => 1, flag2 => 0, status => 'active', bits => q(b'00001'), start => '2001-01-02', save => [ 1, 5 ], nums => '{1,2,3}', last_modified => { le => $o->db->format_timestamp(DateTime->now->add(days => 2)) }, date_created => '2004-03-30 12:34:56.000000000', status => { like => 'AC%', field => 'UPPER(status)' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'name DESC'); is($count, 2, "get_objects_count() 1 - $db_type"); # Set up sub-object for this one test my $b1 = MySQLiteBB->new(id => 1, name => 'one'); $b1->save; $objs->[0]->b1(1); $objs->[0]->save; $count = MySQLiteObjectManager->object_count( share_db => 1, #query_is_sql => 1, require_objects => [ 'bb1' ], query => [ 't2.name' => { like => 'o%' }, 't2_name' => { like => 'on%' }, 'bb1.name' => { like => '%n%' }, id => { ge => 2 }, name => { like => '%e%' }, flag => 1, flag2 => 0, status => 'active', bits => q(b'00001'), start => '2001-01-02', save => [ 1, 5 ], nums => '{1,2,3}', last_modified => { le => $o->db->format_timestamp(DateTime->now->add(days => 2)) }, date_created => '2004-03-30 12:34:56.000000000', status => { like => 'AC%', field => 'UPPER(status)' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'name DESC'); is($count, 1, "get_objects_count() require 1 - $db_type"); # Clear sub-object $objs->[0]->b1(undef); $objs->[0]->save; $b1->delete; my $iterator = MySQLiteObjectManager->get_objectz_iterator( share_db => 1, query_is_sql => 1, query => [ id => { ge => 2 }, name => { like => '%e%' }, flag => 1, flag2 => 0, status => 'active', bits => q(b'00001'), start => '2001-01-02', save => [ 1, 5 ], nums => '{1,2,3}', last_modified => { le => $o->db->format_timestamp(DateTime->now->add(days => 2)) }, date_created => '2004-03-30 12:34:56.000000000', status => { like => 'AC%', field => 'UPPER(status)' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'name'); is(ref $iterator, 'Rose::DB::Object::Iterator', "get_objects_iterator() 1 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "iterator next() 1 - $db_type"); is($o->id, 2, "iterator next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Sue', "iterator next() 3 - $db_type"); is($o->id, 3, "iterator next() 4 - $db_type"); $o = $iterator->next; is($o, 0, "iterator next() 5 - $db_type"); is($iterator->total, 2, "iterator total() - $db_type"); my $fo = MySQLiteOtherObject->new(name => 'Foo 1', k1 => 1, k2 => 2, k3 => 3); ok($fo->save, "object save() 5 - $db_type"); $fo = MySQLiteOtherObject->new(name => 'Foo 2', k1 => 2, k2 => 3, k3 => 4); ok($fo->save, "object save() 6 - $db_type"); $fo = MySQLiteBB->new(id => 1, name => 'one'); ok($fo->save, "bb object save() 1 - $db_type"); $fo = MySQLiteBB->new(id => 2, name => 'two'); ok($fo->save, "bb object save() 2 - $db_type"); $fo = MySQLiteBB->new(id => 3, name => 'three'); ok($fo->save, "bb object save() 3 - $db_type"); $fo = MySQLiteBB->new(id => 4, name => 'four'); ok($fo->save, "bb object save() 4 - $db_type"); my $o5 = MySQLiteObject->new(id => 5, name => 'Betty', flag => 'f', flag2 => 't', status => 'with', bits => '10101', start => '2002-05-20', save_col => 123, nums => [ 4, 5, 6 ], fkone => 1, fk2 => 2, fk3 => 3, b1 => 2, b2 => 4, last_modified => '2001-01-10 20:34:56', date_created => '2002-05-10 10:34:56'); ok($o5->save, "object save() 7 - $db_type"); my $fo1 = $o5->other_obj; ok($fo1 && ref $fo1 && $fo1->k1 == 1 && $fo1->k2 == 2 && $fo1->k3 == 3, "foreign object 1 - $db_type"); $fo1 = $o5->bb1; ok($fo1 && ref $fo1 && $fo1->id == 2, "bb foreign object 1 - $db_type"); $fo1 = $o5->bb2; ok($fo1 && ref $fo1 && $fo1->id == 4, "bb foreign object 2 - $db_type"); $objs = MySQLiteObjectManager->get_objectz( share_db => 1, query_is_sql => 1, query => [ 't1.id' => { ge => 2 }, 't1.name' => { like => '%tt%' }, ], require_objects => [ 'other_obj', 'bb1', 'bb2' ]); ok(ref $objs->[0]->{'other_obj'} eq 'MySQLiteOtherObject', "foreign object 2 - $db_type"); is($objs->[0]->other_obj->k2, 2, "foreign object 3 - $db_type"); is($objs->[0]->bb1->name, 'two', "bb foreign object 3 - $db_type"); is($objs->[0]->bb2->name, 'four', "bb foreign object 4 - $db_type"); $iterator = MySQLiteObjectManager->get_objectz_iterator( share_db => 1, query_is_sql => 1, query => [ 't1.id' => { ge => 2 }, 't1.name' => { like => '%tt%' }, ], require_objects => [ 'other_obj', 'bb1', 'bb2' ]); $o = $iterator->next; ok(ref $o->{'other_obj'} eq 'MySQLiteOtherObject', "foreign object 4 - $db_type"); is($o->other_obj->k2, 2, "foreign object 5 - $db_type"); is($o->bb1->name, 'two', "bb foreign object 5 - $db_type"); is($o->bb2->name, 'four', "bb foreign object 6 - $db_type"); # Start "one to many" tests ok($fo = MySQLiteNick->new(eyedee => 1, o_id => 5, nick => 'none', type => { name => 'nt one', t2 => { name => 'nt2 one' } }, alts => [ { alt => 'alt one 1' }, { alt => 'alt one 2' }, { alt => 'alt one 3' }, ], opts => [ { opt => 'opt one 1' }, { opt => 'opt one 2' } ])->save, "nick object save() 1 - $db_type"); $fo = MySQLiteNick->new(eyedee => 2, o_id => 2, nick => 'ntwo', type => { name => 'nt two', t2 => { name => 'nt2 two' } }, alts => [ { alt => 'alt two 1' } ]); ok($fo->save, "nick object save() 2 - $db_type"); $fo = MySQLiteNick->new(eyedee => 3, o_id => 5, nick => 'nthree', type => { name => 'nt three', t2 => { name => 'nt2 three' } }, opts => [ { opt => 'opt three 1' }, { opt => 'opt three 2' } ]); ok($fo->save, "nick object save() 3 - $db_type"); $fo = MySQLiteNick->new(eyedee => 4, o_id => 2, nick => 'nfour', type => { name => 'nt four', t2 => { name => 'nt2 four' } }); ok($fo->save, "nick object save() 4 - $db_type"); $fo = MySQLiteNick->new(eyedee => 5, o_id => 5, nick => 'nfive', type => { name => 'nt five', t2 => { name => 'nt2 five' } }); ok($fo->save, "nick object save() 5 - $db_type"); $fo = MySQLiteNick->new(eyedee => 6, o_id => 5, nick => 'nsix', type => { name => 'nt six', t2 => { name => 'nt2 six' } }); ok($fo->save, "nick object save() 6 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', share_db => 1, with_objects => [ 'nicks' ], query => [ 't1.id' => { ge => 1 }, 't1.name' => 'Betty', flag => 0, flag2 => 1, bits => '10101', 't2.nick' => { like => 'n%' }, 'eyedee' => { ne => 12345 }, start => '5/20/2002', '!start' => { gt => DateTime->new(year => '2005', month => 12, day => 1) }, '!rose_db_object_test.start' => { gt => DateTime->new(year => '2005', month => 12, day => 2) }, '!t1.start' => { gt => DateTime->new(year => '2005', month => 12, day => 3) }, or => [], and => [], save_col => [ 1, 5, 123 ], #nums => [ 4, 5, 6 ], fk1 => 1, last_modified => { le => '6/6/2020' }, # XXX: breaks in 2020! date_created => '5/10/2002 10:34:56 am' ], clauses => [ "LOWER(status) LIKE 'w%'" ], sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() with many 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() with many 2 - $db_type"); ok(!defined $objs->[0]->{'status'}, "lazy main 1 - $db_type"); is($objs->[0]->status, 'with', "lazy main 2 - $db_type"); my $object = MySQLiteObject->new(id => $objs->[0]->id); $object->load(with => [ 'nicks.type' ]); is($object->{'status'}, undef, "lazy load(with) 1 - $db_type"); my $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db # SQLite seems to disobey the "ORDER BY t1.id, t2.nick DESC" clause $nicks = [ sort { $b->nick cmp $a->nick } @$nicks ]; is(scalar @$nicks, 4, "get_objects() with many 3 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many 4 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many 5 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many 6 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many 7 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', share_db => 1, with_objects => [ 'bb2', 'nicks', 'bb1' ], query => [ 't1.id' => { ge => 1 }, 't1.name' => 'Betty', flag => 0, flag2 => 1, bits => '10101', 't3.nick' => { like => 'n%' }, start => '5/20/2002', '!start' => { gt => DateTime->new(year => '2005', month => 12, day => 1) }, '!rose_db_object_test.start' => { gt => DateTime->new(year => '2005', month => 12, day => 2) }, '!t1.start' => { gt => DateTime->new(year => '2005', month => 12, day => 3) }, save_col => [ 1, 5, 123 ], nums => [ 4, 5, 6 ], fk1 => 1, last_modified => { le => '6/6/2020' }, # XXX: breaks in 2020! date_created => '5/10/2002 10:34:56 am' ], clauses => [ "LOWER(status) LIKE 'w%'" ], sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() with many 8 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() with many 9 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db # SQLite seems to disobey the "ORDER BY t1.id, t2.nick DESC" clause $nicks = [ sort { $b->nick cmp $a->nick } @$nicks ]; is(scalar @$nicks, 4, "get_objects() with many 10 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many 11 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many 12 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many 13 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many 14 - $db_type"); $fo1 = $objs->[0]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects() with many bb1 1 - $db_type"); $fo1 = $objs->[0]->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects() with many bb2 2 - $db_type"); $iterator = MySQLiteObjectManager->get_objectz_iterator( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => [ 'nicks' ], sort_by => 't1.name'); is(ref $iterator, 'Rose::DB::Object::Iterator', "get_objects_iterator() 1 - $db_type"); $o = $iterator->next; is($o->name, 'Betty', "iterator many next() 1 - $db_type"); is($o->id, 5, "iterator many next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Bob', "iterator many next() 3 - $db_type"); is($o->id, 4, "iterator many next() 4 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "iterator many next() 5 - $db_type"); is($o->id, 2, "iterator many next() 6 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "iterator many sub-object 1 - $db_type"); is($o->{'nicks'}[0]{'nick'}, 'ntwo', "iterator many sub-object 2 - $db_type"); is($o->{'nicks'}[1]{'nick'}, 'nfour', "iterator many sub-object 3 - $db_type"); $o = $iterator->next; is($o->name, 'Sue', "iterator many next() 7 - $db_type"); is($o->id, 3, "iterator many next() 8 - $db_type"); $o = $iterator->next; is($o, 0, "iterator many next() 9 - $db_type"); is($iterator->total, 4, "iterator many total() - $db_type"); $iterator = MySQLiteObjectManager->get_objectz_iterator( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], sort_by => 't1.name', limit => 2); $o = $iterator->next; is($o->name, 'Betty', "iterator limit 2 many next() 1 - $db_type"); is($o->id, 5, "iterator limit 2 many next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Bob', "iterator limit 2 many next() 3 - $db_type"); is($o->id, 4, "iterator limit 2 many next() 4 - $db_type"); $o = $iterator->next; is($o, 0, "iterator limit 2 many next() 5 - $db_type"); is($iterator->total, 2, "iterator limit 2 many total() - $db_type"); $iterator = MySQLiteObjectManager->get_objectz_iterator( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => 1, sort_by => 't1.name', limit => 3); $o = $iterator->next; is($o->name, 'Betty', "iterator limit 3 many next() 1 - $db_type"); is($o->id, 5, "iterator limit 3 many next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Bob', "iterator limit 3 many next() 3 - $db_type"); is($o->id, 4, "iterator limit 3 many next() 4 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "iterator limit 3 many next() 5 - $db_type"); is($o->id, 2, "iterator limit 3 many next() 6 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "iterator limit 3 many sub-object 1 - $db_type"); is($o->{'nicks'}[0]{'nick'}, 'ntwo', "iterator limit 3 many sub-object 2 - $db_type"); is($o->{'nicks'}[1]{'nick'}, 'nfour', "iterator limit 3 many sub-object 3 - $db_type"); $o = $iterator->next; is($o, 0, "iterator limit 3 many next() 7 - $db_type"); is($iterator->total, 3, "iterator limit 3 many total() - $db_type"); $objs = MySQLiteObjectManager->get_objectz( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], sort_by => 't1.name', limit => 2); ok(ref $objs && @$objs == 2, "get_objects() limit 2 many 1 - $db_type"); is($objs->[0]->name, 'Betty', "get_objects() limit 2 many 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() limit 2 many 3 - $db_type"); is($objs->[1]->name, 'Bob', "get_objects() limit 2 many 4 - $db_type"); is($objs->[1]->id, 4, "get_objects() limit 2 many 5 - $db_type"); $objs = MySQLiteObjectManager->get_objectz( share_db => 1, with_objects => [ 'nicks', 'bb2' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => 1, sort_by => 't1.name', limit => 3); ok(ref $objs && @$objs == 3, "get_objects() limit 3 many 1 - $db_type"); is($objs->[0]->name, 'Betty', "get_objects() limit 3 many 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() limit 3 many 3 - $db_type"); is($objs->[1]->name, 'Bob', "get_objects() limit 3 many 4 - $db_type"); is($objs->[1]->id, 4, "get_objects() limit 3 many 5 - $db_type"); is($objs->[2]->name, 'Fred', "get_objects() limit 3 many 6 - $db_type"); is($objs->[2]->id, 2, "get_objects() limit 3 many 7 - $db_type"); is(scalar @{$objs->[2]->{'nicks'}}, 2, 'get_objects() limit 3 many sub-object 1'); is($objs->[2]->{'nicks'}[0]{'nick'}, 'ntwo', 'get_objects() limit 3 many sub-object 2'); is($objs->[2]->{'nicks'}[1]{'nick'}, 'nfour', 'get_objects() limit 3 many sub-object 3'); $iterator = MySQLiteObjectManager->get_objectz_iterator( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => 1, sort_by => 't1.name', limit => 2, offset => 1); $o = $iterator->next; is($o->name, 'Bob', "iterator limit 2 offset 1 many next() 1 - $db_type"); is($o->id, 4, "iterator limit 2 offset 1 many next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "iterator limit 2 offset 1 many next() 3 - $db_type"); is($o->id, 2, "iterator limit 2 offset 1 many next() 4 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, 'iterator limit 2 offset 1 many sub-object 1'); is($o->{'nicks'}[0]{'nick'}, 'ntwo', 'iterator limit 2 offset 1 many sub-object 2'); is($o->{'nicks'}[1]{'nick'}, 'nfour', 'iterator limit 2 offset 1 many sub-object 3'); $o = $iterator->next; is($o, 0, "iterator limit 2 offset 1 many next() 5 - $db_type"); is($iterator->total, 2, "iterator limit 2 offset 1 many total() - $db_type"); $iterator = MySQLiteObjectManager->get_objectz_iterator( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => 1, sort_by => 't1.name', limit => 3, offset => 2); $o = $iterator->next; is($o->name, 'Fred', "iterator limit 3 offset 2 many next() 1 - $db_type"); is($o->id, 2, "iterator limit 3 offset 2 many next() 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, 'iterator limit 3 offset 2 many sub-object 1'); is($o->{'nicks'}[0]{'nick'}, 'ntwo', 'iterator limit 3 offset 2 many sub-object 2'); is($o->{'nicks'}[1]{'nick'}, 'nfour', 'iterator limit 3 offset 2 many sub-object 3'); $o = $iterator->next; is($o->name, 'Sue', "iterator limit 3 offset 2 many next() 3 - $db_type"); is($o->id, 3, "iterator limit 3 offset 2 many next() 4 - $db_type"); $o = $iterator->next; is($o, 0, "iterator limit 3 offset 2 many next() 5 - $db_type"); is($iterator->total, 2, "iterator limit 3 offset 2 many total() - $db_type"); $objs = MySQLiteObjectManager->get_objectz( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => 1, sort_by => 't1.name', limit => 2, offset => 1); ok(ref $objs && @$objs == 2, "get_objects() limit 2 offset 1 many 1 - $db_type"); is($objs->[0]->name, 'Bob', "get_objects() limit 2 offset 1 many 2 - $db_type"); is($objs->[0]->id, 4, "get_objects() limit 2 offset 1 many 3 - $db_type"); is($objs->[1]->name, 'Fred', "get_objects() limit 2 offset 1 many 4 - $db_type"); is($objs->[1]->id, 2, "get_objects() limit 2 offset 1 many 5 - $db_type"); is(scalar @{$objs->[1]->{'nicks'}}, 2, 'get_objects() limit 2 offset 1 many sub-object 1'); is($objs->[1]->{'nicks'}[0]{'nick'}, 'ntwo', 'get_objects() limit 2 offset 1 many sub-object 2'); is($objs->[1]->{'nicks'}[1]{'nick'}, 'nfour', 'get_objects() limit 2 offset 1 many sub-object 3'); $objs = MySQLiteObjectManager->get_objectz( share_db => 1, with_objects => [ 'nicks', 'bb2' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => 1, sort_by => 't1.name', limit => 3, offset => 2); ok(ref $objs && @$objs == 2, "get_objects() limit 3 offset 2 many 1 - $db_type"); is($objs->[0]->name, 'Fred', "get_objects() limit 3 offset 2 many 2 - $db_type"); is($objs->[0]->id, 2, "get_objects() limit 3 offset 2 many 3 - $db_type"); is(scalar @{$objs->[0]->{'nicks'}}, 2, 'get_objects() limit 3 offset 2 many sub-object 1'); is($objs->[0]->{'nicks'}[0]{'nick'}, 'ntwo', 'get_objects() limit 3 offset 2 many sub-object 2'); is($objs->[0]->{'nicks'}[1]{'nick'}, 'nfour', 'get_objects() limit 3 offset 2 many sub-object 3'); is($objs->[1]->name, 'Sue', "get_objects() limit 3 offset 2 many 4 - $db_type"); is($objs->[1]->id, 3, "get_objects() limit 3 offset 2 many 5 - $db_type"); my $o6 = $o2->clone; $o6->id(60); $o6->fkone(undef); $o6->fk2(undef); $o6->fk3(undef); $o6->b1(undef); $o6->b2(2); $o6->name('Ted'); ok($o6->save, "object save() 8 - $db_type"); my $o7 = $o2->clone; $o7->id(70); $o7->b1(3); $o7->b2(undef); $o7->name('Joe'); ok($o7->save, "object save() 9 - $db_type"); my $o8 = $o2->clone; $o8->id(80); $o8->b1(undef); $o8->b2(undef); $o8->name('Pete'); ok($o8->save, "object save() 10 - $db_type"); $fo = MySQLiteNick->new(eyedee => 7, o_id => 60, nick => 'nseven'); ok($fo->save, "nick object save() 7 - $db_type"); $fo = MySQLiteNick->new(eyedee => 8, o_id => 60, nick => 'neight'); ok($fo->save, "nick object save() 8 - $db_type"); $fo = MySQLiteNick->new(eyedee => 9, o_id => 60, nick => 'neight'); ok($fo->save, "nick object save() 8 - $db_type"); $fo = MySQLiteNick2->new(id => 1, o_id => 5, nick2 => 'n2one'); ok($fo->save, "nick2 object save() 1 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', share_db => 1, require_objects => [ 'bb2', 'bb1' ], query => [ '!t1.id' => 5 ], sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() with many 15 - $db_type"); $objs ||= []; is(scalar @$objs, 0, "get_objects() with many 16 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( object_class => 'MySQLiteObject', share_db => 1, require_objects => [ 'bb2', 'bb1' ], with_objects => [ 'nicks' ], query => [ ], sort_by => 't1.id'); is($count, 1, "get_objects_count() require 1 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; $count = Rose::DB::Object::Manager->get_objects_count( object_class => 'MySQLiteObject', share_db => 1, require_objects => [ 'bb2' ], with_objects => [ 'nicks' ], query => [ ], sort_by => 't1.id'); is($count, 2, "get_objects_count() require 2 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', share_db => 1, require_objects => [ 'bb2', 'bb1' ], with_objects => [ 'nicks' ], query => [ ], sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() with many 17 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() with many 18 - $db_type"); is($objs->[0]->id, 5, "get_objects() with many 19 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db # SQLite seems to disobey the "ORDER BY t1.id, t2.nick DESC" clause $nicks = [ sort { $b->nick cmp $a->nick } @$nicks ]; is(scalar @$nicks, 4, "get_objects() with many 20 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many 21 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many 22 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many 23 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many 24 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', share_db => 1, require_objects => [ 'bb1', 'bb2' ], with_objects => [ 'nicks2', 'nicks' ], multi_many_ok => 1, query => [ ], sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() with multi many 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() with multi many 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() with multi many 3 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db # SQLite seems to disobey the "ORDER BY t1.id, t2.nick DESC" clause $nicks = [ sort { $b->nick cmp $a->nick } @$nicks ]; is(scalar @$nicks, 4, "get_objects() with multi many 4 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with multi many 5 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with multi many 6 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with multi many 7 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with multi many 8 - $db_type"); is($objs->[0]->{'nicks2'}[0]{'nick2'}, 'n2one', "get_objects() with multi many 9 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MySQLiteObject', share_db => 1, require_objects => [ 'bb1', 'bb2' ], with_objects => [ 'nicks2', 'nicks' ], multi_many_ok => 1, query => [ ], sort_by => 't1.id'); $o = $iterator->next; is($o->name, 'Betty', "iterator with and require 1 - $db_type"); is($o->id, 5, "iterator with and require 2 - $db_type"); $nicks = $o->{'nicks'}; # make sure this isn't hitting the db # SQLite seems to disobey the "ORDER BY t1.id, t2.nick DESC" clause $nicks = [ sort { $b->nick cmp $a->nick } @$nicks ]; is(scalar @$nicks, 4, "iterator with and require 3 - $db_type"); is($nicks->[0]->nick, 'nthree', "iterator with and require 4 - $db_type"); is($nicks->[1]->nick, 'nsix', "iterator with and require 5 - $db_type"); is($nicks->[2]->nick, 'none', "iterator with and require 6 - $db_type"); is($nicks->[3]->nick, 'nfive', "iterator with and require 7 - $db_type"); is($o->{'nicks2'}[0]{'nick2'}, 'n2one', "iterator with and require 8 - $db_type"); $o = $iterator->next; is($o, 0, "iterator with and require 9 - $db_type"); is($iterator->total, 1, "iterator with and require 10 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', share_db => 1, with_objects => [ 'bb2', 'nicks', 'bb1' ], query => [ ], sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() with many 25 - $db_type"); $objs ||= []; is(scalar @$objs, 8, "get_objects() with many 26 - $db_type"); my $ids = join(',', map { $_->id } @$objs); is($ids, '1,2,3,4,5,60,70,80', "get_objects() with many 27 - $db_type"); $nicks = $objs->[4]->{'nicks'}; # make sure this isn't hitting the db # SQLite seems to disobey the "ORDER BY t1.id, t2.nick DESC" clause $nicks = [ sort { $b->nick cmp $a->nick } @$nicks ]; is(scalar @$nicks, 4, "get_objects() with many 28 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many 29 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many 30 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many 31 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many 32 - $db_type"); is($objs->[6]->{'bb1'}->{'name'}, 'three', "get_objects() with many 33 - $db_type"); ok(!defined $objs->[6]->{'bb2'}, "get_objects() with many 34 - $db_type"); ok(!defined $objs->[6]->{'nicks'}, "get_objects() with many 35 - $db_type"); ok(!defined $objs->[7]->{'bb1'}, "get_objects() with many 36 - $db_type"); ok(!defined $objs->[7]->{'bb1'}, "get_objects() with many 37 - $db_type"); ok(!defined $objs->[7]->{'nicks'}, "get_objects() with many 38 - $db_type"); $fo = MySQLiteNick->new(eyedee => 7); ok($fo->delete, "with many clean-up 1 - $db_type"); $fo = MySQLiteNick->new(eyedee => 8); ok($fo->delete, "with many clean-up 2 - $db_type"); $fo = MySQLiteNick->new(eyedee => 9); ok($fo->delete, "with many clean-up 3 - $db_type"); ok($o6->delete, "with many clean-up 4 - $db_type"); ok($o7->delete, "with many clean-up 5 - $db_type"); ok($o8->delete, "with many clean-up 6 - $db_type"); $fo = MySQLiteNick2->new(id => 1); ok($fo->delete, "with many clean-up 7 - $db_type"); # End "one to many" tests $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', share_db => 1, query => [ id => { ge => 1 }, name => 'John', flag => 1, flag2 => 0, status => 'active', bits => '1', start => '1/2/2001', '!start' => { gt => DateTime->new(year => '2005', month => 1, day => 1) }, '!rose_db_object_test.start' => { gt => DateTime->new(year => '2005', month => 2, day => 2) }, '!t1.start' => { gt => DateTime->new(year => '2005', month => 3, day => 3) }, save_col => [ 1, 5 ], nums => [ 1, 2, 3 ], fk1 => 2, last_modified => { le => '6/6/2020' }, # XXX: breaks in 2020! date_created => '3/30/2004 12:34:56 pm' ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() 7 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() 8 - $db_type"); $objs = MySQLiteObjectManager->get_objectz( share_db => 1, query => [ id => { ge => 2 }, k1 => { lt => 900 }, or => [ k1 => { ne => 99 }, k1 => 100 ], or => [ and => [ id => { ne => 123 }, id => { lt => 100 } ], and => [ id => { ne => 456 }, id => { lt => 300 } ] ], '!k2' => { gt => 999 }, '!t2.name' => 'z', start => { lt => DateTime->new(year => '2005', month => 1, day => 1) }, '!start' => { gt => DateTime->new(year => '2005', month => 1, day => 1) }, 'rose_db_object_test.name' => { like => '%tt%' }, '!rose_db_object_other.name' => 'q', '!rose_db_object_other.name' => [ 'x', 'y' ], ], require_objects => [ 'other_obj' ]); ok(ref $objs->[0]->{'other_obj'} eq 'MySQLiteOtherObject', "foreign object 6 - $db_type"); is($objs->[0]->other_obj->k2, 2, "foreign object 7 - $db_type"); # Test limit with offset foreach my $id (6 .. 20) { my $o = $o5->clone; $o->id($id); $o->name("Clone $id"); ok($o->save, "object save() clone $id - $db_type"); } $objs = MySQLiteObjectManager->get_objectz( object_class => 'MySQLiteObject', sort_by => 'id DESC', limit => 2, offset => 8); ok(ref $objs eq 'ARRAY' && @$objs == 2 && $objs->[0]->id == 12 && $objs->[1]->id == 11, "get_objects() with offset - $db_type"); $objs = MySQLiteObjectManager->get_objectz( object_class => 'MySQLiteObject', sort_by => 'id DESC', require_objects => [ 'other_obj' ], limit => 2, offset => 8); ok(ref $objs eq 'ARRAY' && @$objs == 2 && $objs->[0]->id == 12 && $objs->[1]->id == 11, "get_objects() with objects and offset - $db_type"); $iterator = MySQLiteObjectManager->get_objectz_iterator( object_class => 'MySQLiteObject', sort_by => 'id DESC', limit => 2, offset => 8); $o = $iterator->next; is($o->id, 12, "get_objects_iterator() with offset 1 - $db_type"); $o = $iterator->next; is($o->id, 11, "get_objects_iterator() with offset 2 - $db_type"); is($iterator->next, 0, "get_objects_iterator() with offset 3 - $db_type"); eval { $objs = MySQLiteObjectManager->get_objectz( object_class => 'MySQLiteObject', sort_by => 'id DESC', offset => 8) }; ok($@ =~ /invalid without a limit/, "get_objects() missing offset - $db_type"); eval { $iterator = MySQLiteObjectManager->get_objectz_iterator( object_class => 'MySQLiteObject', sort_by => 'id DESC', offset => 8); }; ok($@ =~ /invalid without a limit/, "get_objects_iterator() missing offset - $db_type"); # Start *_sql comparison tests $o6->fk2(99); $o6->fk3(99); $o6->save; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', query => [ 'fk2' => { eq_sql => 'fk3' } ], sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq_sql 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() eq_sql 2 - $db_type"); is($objs->[0]->id, 60, "get_objects() eq_sql 3 - $db_type"); # End *_sql comparison tests # Start IN NULL tests #local $Rose::DB::Object::Manager::Debug = 1; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', query => [ id => [ undef, 60 ], '!id' => \'id + 1' ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() in null 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() in null 2 - $db_type"); is($objs->[0]->id, 60, "get_objects() in null 3 - $db_type"); # End IN NULL tests # Start scalar ref tests #local $Rose::DB::Object::Manager::Debug = 1; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', query => [ 'fk2' => \'fk3' ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq ref 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() eq ref 2 - $db_type"); is($objs->[0]->id, 60, "get_objects() eq ref 3 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', #query => [ 'fk2' => [ \'fk3' ] ], #' query => [ 'fk2' => \'fk3' ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq ref 4 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() eq ref 5 - $db_type"); is($objs->[0]->id, 60, "get_objects() eq ref 6 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', query => [ 'fk2' => { ne => \'fk3' } ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq ref 7 - $db_type"); $objs ||= []; is(scalar @$objs, 16, "get_objects() eq ref 8 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', query => [ 'fk2' => { ne => [ \'fk3' ] } ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq ref 9 - $db_type"); $objs ||= []; is(scalar @$objs, 16, "get_objects() eq ref 10 - $db_type"); # End scalar ref tests # Start "many to many" tests $fo = MySQLiteColor->new(id => 1, name => 'Red'); $fo->save; $fo = MySQLiteColor->new(id => 2, name => 'Green'); $fo->save; $fo = MySQLiteColor->new(id => 3, name => 'Blue'); $fo->save; $fo = MySQLiteColorMap->new(id => 1, object_id => $o2->id, color_id => 1); $fo->save; $fo = MySQLiteColorMap->new(id => 2, object_id => $o2->id, color_id => 3); $fo->save; $o2->b1(4); $o2->b1(2); $o2->fkone(2); $o2->fk2(3); $o2->fk3(4); $o2->save; my @colors = $o2->colors; ok(@colors == 2 && $colors[0]->name eq 'Red' && $colors[1]->name eq 'Blue', "Fetch many to many 1 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', share_db => 1, with_objects => [ 'other_obj', 'bb2', 'nicks', 'bb1', 'colors' ], multi_many_ok => 1, with_map_records => 'map_record', query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); test_memory_cycle_ok($objs, "get_objects() with many to many cycle - $db_type"); is(ref $objs, 'ARRAY', "get_objects() with many to many 1 - $db_type"); $objs ||= []; is(scalar @$objs, 3, "get_objects() with many to many 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() with many to many 3 - $db_type"); is($objs->[1]->id, 2, "get_objects() with many to many 4 - $db_type"); is($objs->[2]->id, 1, "get_objects() with many to many 5 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many to many 6 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many to many 7 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many to many 8 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many to many 9 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many to many 10 - $db_type"); $fo1 = $objs->[0]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects() with many to many 11 - $db_type"); $fo1 = $objs->[0]->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects() with many to many 12 - $db_type"); my $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() with many to many 13 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() with many to many 14 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects() with many to many 15 - $db_type"); is($colors->[0]->map_record->color_id, $colors->[0]->id, "map_record 1 - $db_type"); is($colors->[0]->map_record->object_id, $objs->[1]->id, "map_record 2 - $db_type"); is($colors->[1]->map_record->color_id, $colors->[1]->id, "map_record 3 - $db_type"); is($colors->[0]->map_record->object_id, $objs->[1]->id, "map_record 4 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MySQLiteObject', share_db => 1, with_objects => [ 'other_obj', 'bb2', 'nicks', 'bb1', 'colors' ], multi_many_ok => 1, with_map_records => 'map_record', query => [ id => [ 1, 2, 5 ] ], sort_by => 't1.name'); $objs = []; while(my $obj = $iterator->next) { push(@$objs, $obj); } is(ref $objs, 'ARRAY', "get_objects_iterator() with many to many map record 1 - $db_type"); is(scalar @$objs, 3, "get_objects_iterator() with many to many map record 2 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db is($colors->[0]->map_record->color_id, $colors->[0]->id, "map_record 5 - $db_type"); is($colors->[0]->map_record->object_id, $objs->[1]->id, "map_record 6 - $db_type"); is($colors->[1]->map_record->color_id, $colors->[1]->id, "map_record 7 - $db_type"); is($colors->[0]->map_record->object_id, $objs->[1]->id, "map_record 8 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', share_db => 1, with_objects => [ 'other_obj', 'bb2', 'nicks', 'bb1', 'colors' ], multi_many_ok => 1, with_map_records => 'map_rec', query => [ id => [ 1, 2, 5 ] ], sort_by => 't1.name'); is(ref $objs, 'ARRAY', "get_objects() with many to many 1 - $db_type"); $objs ||= []; is(scalar @$objs, 3, "get_objects() with many to many 2 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db is($colors->[0]->map_rec->color_id, $colors->[0]->id, "map_rec 1 - $db_type"); is($colors->[0]->map_rec->object_id, $objs->[1]->id, "map_rec 2 - $db_type"); is($colors->[1]->map_rec->color_id, $colors->[1]->id, "map_rec 3 - $db_type"); is($colors->[0]->map_rec->object_id, $objs->[1]->id, "map_rec 4 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', share_db => 1, with_objects => [ 'bb1', 'nicks', 'other_obj', 'colors', 'bb2' ], multi_many_ok => 1, query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); is(ref $objs, 'ARRAY', "get_objects() with many to many (reorder) 1 - $db_type"); $objs ||= []; is(scalar @$objs, 3, "get_objects() with many to many (reorder) 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() with many to many (reorder) 3 - $db_type"); is($objs->[1]->id, 2, "get_objects() with many to many (reorder) 4 - $db_type"); is($objs->[2]->id, 1, "get_objects() with many to many (reorder) 5 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many to many (reorder) 6 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many to many (reorder) 7 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many to many (reorder) 8 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many to many (reorder) 9 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many to many (reorder) 10 - $db_type"); $fo1 = $objs->[0]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects() with many to many (reorder) 11 - $db_type"); $fo1 = $objs->[0]->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects() with many to many (reorder) 12 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() with many to many (reorder) 13 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() with many to many (reorder) 14 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects() with many to many (reorder) 15 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', share_db => 1, with_objects => [ 'nicks', 'colors', 'bb2' ], multi_many_ok => 1, require_objects => [ 'bb1', 'other_obj' ], query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); is(ref $objs, 'ARRAY', "get_objects() with many to many require with 1 - $db_type"); $objs ||= []; is(scalar @$objs, 2, "get_objects() with many to many require with 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() with many to many require with 3 - $db_type"); is($objs->[1]->id, 2, "get_objects() with many to many require with 4 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many to many require with 6 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many to many 7 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many to many 8 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many to many 9 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many to many 10 - $db_type"); $fo1 = $objs->[0]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects() with many to many require with 11 - $db_type"); $fo1 = $objs->[0]->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects() with many to many require with 12 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() with many to many require with 13 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() with many to many require with 14 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects() with many to many require with 15 - $db_type"); $fo1 = $objs->[1]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'two', "get_objects() with many to many require with 16 - $db_type"); $fo1 = $objs->[0]->{'other_obj'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'Foo 1', "get_objects() with many to many require with 17 - $db_type"); $fo1 = $objs->[1]->{'other_obj'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'Foo 2', "get_objects() with many to many require with 18 - $db_type"); ok(!defined $objs->[0]->{'colors'}, "get_objects() with many to many require with 19 - $db_type"); ok(!defined $objs->[1]->{'bb2'}, "get_objects() with many to many require with 20 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MySQLiteObject', share_db => 1, with_objects => [ 'other_obj', 'bb2', 'nicks', 'bb1', 'colors' ], multi_many_ok => 1, query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); $o = $iterator->next; is($o->name, 'Betty', "get_objects_iterator() with many to many 1 - $db_type"); is($o->id, 5, "get_objects_iterator() with many to many 2 - $db_type"); $nicks = $o->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects_iterator() with many to many 3 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects_iterator() with many to many 4 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects_iterator() with many to many 5 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects_iterator() with many to many 6 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects_iterator() with many to many 7 - $db_type"); $fo1 = $o->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects_iterator() with many to many 8 - $db_type"); $fo1 = $o->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects_iterator() with many to many 9 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "get_objects_iterator() with many to many 10 - $db_type"); is($o->id, 2, "get_objects_iterator() with many to many 11 - $db_type"); $colors = $o->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects_iterator() with many to many 12 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many 13 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many 14 - $db_type"); $o = $iterator->next; is($o->name, 'John', "get_objects_iterator() with many to many 15 - $db_type"); is($o->id, 1, "get_objects_iterator() with many to many 16 - $db_type"); $o = $iterator->next; is($o, 0, "get_objects_iterator() with many to many 17 - $db_type"); is($iterator->total, 3, "get_objects_iterator() with many to many 18 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MySQLiteObject', share_db => 1, with_objects => [ 'bb1', 'nicks', 'other_obj', 'colors', 'bb2' ], multi_many_ok => 1, query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); $o = $iterator->next; is($o->name, 'Betty', "get_objects_iterator() with many to many 19 - $db_type"); is($o->id, 5, "get_objects_iterator() with many to many 20 - $db_type"); $nicks = $o->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects_iterator() with many to many 21 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects_iterator() with many to many 22 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects_iterator() with many to many 23 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects_iterator() with many to many 24 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects_iterator() with many to many 25 - $db_type"); $fo1 = $o->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects_iterator() with many to many 26 - $db_type"); $fo1 = $o->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects_iterator() with many to many 27 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "get_objects_iterator() with many to many 28 - $db_type"); is($o->id, 2, "get_objects_iterator() with many to many 29 - $db_type"); $colors = $o->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects_iterator() with many to many 30 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many 31 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many 32 - $db_type"); $o = $iterator->next; is($o->name, 'John', "get_objects_iterator() with many to many 33 - $db_type"); is($o->id, 1, "get_objects_iterator() with many to many 34 - $db_type"); $o = $iterator->next; is($o, 0, "get_objects_iterator() with many to many 35 - $db_type"); is($iterator->total, 3, "get_objects_iterator() with many to many 36 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MySQLiteObject', share_db => 1, with_objects => [ 'nicks', 'colors', 'bb2' ], multi_many_ok => 1, require_objects => [ 'bb1', 'other_obj' ], query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); $o = $iterator->next; is($o->name, 'Betty', "get_objects_iterator() with many to many require 1 - $db_type"); is($o->id, 5, "get_objects_iterator() with many to many require 2 - $db_type"); $fo1 = $o->{'other_obj'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'Foo 1', "get_objects_iterator() with many to many require 3 - $db_type"); ok(!defined $o->{'colors'}, "get_objects_iterator() with many to many require 4 - $db_type"); $nicks = $o->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects_iterator() with many to many require 5 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects_iterator() with many to many require 6 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects_iterator() with many to many require 7 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects_iterator() with many to many require 8 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects_iterator() with many to many require 9 - $db_type"); $fo1 = $o->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects_iterator() with many to many require 10 - $db_type"); $fo1 = $o->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects_iterator() with many to many require 11 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "get_objects_iterator() with many to many require 12 - $db_type"); is($o->id, 2, "get_objects_iterator() with many to many require 13 - $db_type"); $colors = $o->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects_iterator() with many to many require 14 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many require 15 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many require 16 - $db_type"); $fo1 = $o->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'two', "get_objects_iterator() with many to many require 17 - $db_type"); $fo1 = $o->{'other_obj'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'Foo 2', "get_objects_iterator() with many to many require 18 - $db_type"); ok(!defined $o->{'bb2'}, "get_objects_iterator() with many to many require 19 - $db_type"); $o = $iterator->next; is($o, 0, "get_objects_iterator() with many to many require 20 - $db_type"); is($iterator->total, 2, "get_objects_iterator() with many to many require 21 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MySQLiteObject', share_db => 1, with_objects => [ 'nicks', 'colors', 'bb2' ], multi_many_ok => 1, require_objects => [ 'bb1', 'other_obj' ], query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name', limit => 1, offset => 5); ok(!$iterator->next, "get_objects_iterator() with many to many require 22 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', share_db => 1, with_objects => [ 'nicks', 'colors', 'bb2' ], multi_many_ok => 1, require_objects => [ 'bb1', 'other_obj' ], query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name', limit => 1, offset => 5); ok(@$objs == 0, "get_objects_iterator() with many to many require 23 - $db_type"); # End "many to many" tests # Start multi-require tests $fo = MySQLiteColorMap->new(id => 3, object_id => 5, color_id => 2); $fo->save; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', share_db => 1, require_objects => [ 'nicks', 'colors', 'other_obj' ], multi_many_ok => 1, sort_by => 't1.name'); is(scalar @$objs, 2, "get_objects() multi many require 1 - $db_type"); is($objs->[0]->id, 5, "get_objects() multi many require 2 - $db_type"); is($objs->[1]->id, 2, "get_objects() multi many require 3 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() multi many require 4 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() multi many require 5 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() multi many require 6 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() multi many require 7 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() multi many require 8 - $db_type"); $colors = $objs->[0]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 1, "get_objects() multi many require 9 - $db_type"); ok($colors->[0]->id == 2 && $colors->[0]->name eq 'Green', "get_objects() multi many require 10 - $db_type"); $nicks = $objs->[1]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 2, "get_objects() multi many require 11 - $db_type"); is($nicks->[0]->nick, 'ntwo', "get_objects() multi many require 12 - $db_type"); is($nicks->[1]->nick, 'nfour', "get_objects() multi many require 13 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() multi many require 14 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() multi many require 15 - $db_type"); ok($colors->[1]->id == 3 && $colors->[1]->name eq 'Blue', "get_objects() multi many require 16 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', share_db => 1, require_objects => [ 'nicks', 'colors', 'other_obj' ], with_objects => [ 'bb2' ], multi_many_ok => 1, sort_by => 't1.name'); is(scalar @$objs, 2, "get_objects() multi many with require 1 - $db_type"); is($objs->[0]->id, 5, "get_objects() multi many with require 2 - $db_type"); is($objs->[1]->id, 2, "get_objects() multi many with require 3 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() multi many with require 4 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() multi many with require 5 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() multi many with require 6 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() multi many with require 7 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() multi many with require 8 - $db_type"); $colors = $objs->[0]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 1, "get_objects() multi many with require 9 - $db_type"); ok($colors->[0]->id == 2 && $colors->[0]->name eq 'Green', "get_objects() multi many with require 10 - $db_type"); $nicks = $objs->[1]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 2, "get_objects() multi many with require 11 - $db_type"); is($nicks->[0]->nick, 'ntwo', "get_objects() multi many with require 12 - $db_type"); is($nicks->[1]->nick, 'nfour', "get_objects() multi many with require 13 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() multi many with require 14 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() multi many with require 15 - $db_type"); ok($colors->[1]->id == 3 && $colors->[1]->name eq 'Blue', "get_objects() multi many with require 16 - $db_type"); is($objs->[0]->{'bb2'}{'name'}, 'four', "get_objects() multi many with require 17 - $db_type"); ok(!defined $objs->[1]->{'bb2'}{'name'}, "get_objects() multi many with require 18 - $db_type"); MySQLiteNick->new(eyedee => 7, o_id => 10, nick => 'nseven')->save; MySQLiteNick->new(eyedee => 8, o_id => 11, nick => 'neight')->save; MySQLiteNick->new(eyedee => 9, o_id => 12, nick => 'nnine')->save; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', share_db => 1, require_objects => [ 'nicks', 'bb1' ], with_objects => [ 'colors' ], multi_many_ok => 1, sort_by => 't1.name'); is(scalar @$objs, 5, "get_objects() multi many with require map 1 - $db_type"); is($objs->[0]->id, 5, "get_objects() multi many with require map 2 - $db_type"); is($objs->[1]->id, 10, "get_objects() multi many with require map 3 - $db_type"); is($objs->[2]->id, 11, "get_objects() multi many with require map 4 - $db_type"); is($objs->[3]->id, 12, "get_objects() multi many with require map 5 - $db_type"); is($objs->[4]->id, 2, "get_objects() multi many with require map 6 - $db_type"); # End multi-require tests # Start distinct tests my $i = 0; foreach my $distinct (1, [ 't1' ], [ 'rose_db_object_test' ]) { $i++; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', distinct => $distinct, share_db => 1, require_objects => [ 'nicks', 'colors', 'other_obj' ], multi_many_ok => 1, sort_by => 't1.name'); is(scalar @$objs, 2, "get_objects() distinct multi many require $i.1 - $db_type"); is($objs->[0]->id, 5, "get_objects() distinct multi many require $i.2 - $db_type"); is($objs->[1]->id, 2, "get_objects() distinct multi many require $i.3 - $db_type"); ok(!defined $objs->[0]->{'nicks'}, "get_objects() distinct multi many require $i.4 - $db_type"); ok(!defined $objs->[0]->{'colors'}, "get_objects() distinct multi many require $i.5 - $db_type"); ok(!defined $objs->[1]->{'nicks'}, "get_objects() distinct multi many require $i.6 - $db_type"); ok(!defined $objs->[1]->{'colors'}, "get_objects() distinct multi many require $i.7 - $db_type"); } #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; foreach my $distinct ([ 't2' ], [ 'rose_db_object_nicks' ], [ 'nicks' ]) { $i++; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', distinct => $distinct, share_db => 1, require_objects => [ 'nicks', 'colors', 'other_obj' ], multi_many_ok => 1, nonlazy => 1, sort_by => 't1.name'); is(scalar @$objs, 2, "get_objects() distinct multi many require $i.1 - $db_type"); is($objs->[0]->id, 5, "get_objects() distinct multi many require $i.2 - $db_type"); is($objs->[1]->id, 2, "get_objects() distinct multi many require $i.3 - $db_type"); ok(defined $objs->[0]->{'nicks'}, "get_objects() distinct multi many require $i.4 - $db_type"); ok(!defined $objs->[0]->{'colors'}, "get_objects() distinct multi many require $i.5 - $db_type"); ok(defined $objs->[1]->{'nicks'}, "get_objects() distinct multi many require $i.6 - $db_type"); ok(!defined $objs->[1]->{'colors'}, "get_objects() distinct multi many require $i.7 - $db_type"); } # End distinct tests # Start pager tests is(Rose::DB::Object::Manager->default_objects_per_page, 20, 'default_objects_per_page 1'); Rose::DB::Object::Manager->default_objects_per_page(3); my $per_page = Rose::DB::Object::Manager->default_objects_per_page; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 1, per_page => 3); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 1.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 1); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 2.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', query => [ id => { le => 11 } ], sort_by => 't1.id', per_page => 3); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 3.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', query => [ id => { le => 11 } ], sort_by => 't1.id', per_page => -1); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 4.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => -1); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 5.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => undef); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 6.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', query => [ id => { le => 11 } ], sort_by => 't1.id', per_page => undef); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 7.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', query => [ id => { le => 11 } ], sort_by => 't1.id'); ok(scalar @$objs > 3, "pager 8 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 2, per_page => 3); $i = 0; for(4 .. 6) { is($objs->[$i++]->id, $_, "pager 9.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 3, per_page => 3); $i = 0; for(7 .. 9) { is($objs->[$i++]->id, $_, "pager 10.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 4, per_page => 3); $i = 0; for(10 .. 11) { is($objs->[$i++]->id, $_, "pager 11.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 5, per_page => 3); ok(scalar @$objs == 0, "pager 12 - $db_type"); Rose::DB::Object::Manager->default_objects_per_page(20); # End pager tests # Start get_objects_from_sql tests eval { $objs = MySQLiteObjectManager->get_objects_from_sql( db => MySQLiteObject->init_db, object_class => 'MySQLiteObject', sql => <<"EOF"); SELECT id, id as nonesuch FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF }; like($@, qr/method "nonesuch"/, "get_objects_from_sql error message - $db_type"); $objs = MySQLiteObjectManager->get_objects_from_sql( db => MySQLiteObject->init_db, object_class => 'MySQLiteObject', prepare_cached => 1, sql => <<"EOF"); SELECT * FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF ok(scalar @$objs == 19, "get_objects_from_sql 1 - $db_type"); is($objs->[18]->id, 1, "get_objects_from_sql 2 - $db_type"); is($objs->[18]->save_col, 5, "get_objects_from_sql 3 - $db_type"); is($objs->[18]->name, 'John', "get_objects_from_sql 4 - $db_type"); $iterator = MySQLiteObjectManager->get_objects_iterator_from_sql( db => MySQLiteObject->init_db, object_class => 'MySQLiteObject', prepare_cached => 1, sql => <<"EOF"); SELECT * FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF for(0 .. 17) { $iterator->next } $o = $iterator->next; is($o->id, 1, "get_objects_iterator_from_sql 1 - $db_type"); is($o->save_col, 5, "get_objects_iterator_from_sql 2 - $db_type"); is($o->name, 'John', "get_objects_iterator_from_sql 3 - $db_type"); ok(!$iterator->next, "get_objects_iterator_from_sql 4 - $db_type"); $objs = MySQLiteObjectManager->get_objects_from_sql(<<"EOF"); SELECT * FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF ok(scalar @$objs == 19, "get_objects_from_sql 5 - $db_type"); is($objs->[18]->id, 1, "get_objects_from_sql 6 - $db_type"); is($objs->[18]->save_col, 5, "get_objects_from_sql 7 - $db_type"); is($objs->[18]->name, 'John', "get_objects_from_sql 8 - $db_type"); $objs = MySQLiteObjectManager->get_objects_from_sql( args => [ 19 ], sql => <<"EOF"); SELECT * FROM rose_db_object_test WHERE id > ? ORDER BY id DESC EOF ok(scalar @$objs == 2, "get_objects_from_sql 9 - $db_type"); is($objs->[0]->id, 60, "get_objects_from_sql 10 - $db_type"); my $method = MySQLiteObjectManager->make_manager_method_from_sql( get_em => <<"EOF"); SELECT *, save + fk1 AS extra FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF $objs = MySQLiteObjectManager->get_em; ok(scalar @$objs == 19, "make_manager_method_from_sql 1 - $db_type"); is($objs->[17]->id, 3, "make_manager_method_from_sql 2 - $db_type"); is($objs->[17]->extra, 7, "make_manager_method_from_sql 3 - $db_type"); is($objs->[17]->name, 'Sue', "make_manager_method_from_sql 4 - $db_type"); $objs = $method->('MySQLiteObjectManager'); ok(scalar @$objs == 19, "make_manager_method_from_sql 5 - $db_type"); is($objs->[17]->id, 3, "make_manager_method_from_sql 6 - $db_type"); is($objs->[17]->extra, 7, "make_manager_method_from_sql 7 - $db_type"); is($objs->[17]->name, 'Sue', "make_manager_method_from_sql 8 - $db_type"); $method = MySQLiteObjectManager->make_manager_method_from_sql( iterator => 1, method => 'iter_em', sql => <<"EOF"); SELECT *, save + fk1 AS extra FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF $iterator = MySQLiteObjectManager->iter_em; for(0 .. 16) { $iterator->next } $o = $iterator->next; is($objs->[17]->id, 3, "make_manager_method_from_sql iterator 1 - $db_type"); is($objs->[17]->extra, 7, "make_manager_method_from_sql iterator 2 - $db_type"); is($objs->[17]->name, 'Sue', "make_manager_method_from_sql iterator 3 - $db_type"); $iterator = $method->('MySQLiteObjectManager'); for(0 .. 16) { $iterator->next } $o = $iterator->next; is($objs->[17]->id, 3, "make_manager_method_from_sql iterator 4 - $db_type"); is($objs->[17]->extra, 7, "make_manager_method_from_sql iterator 5 - $db_type"); is($objs->[17]->name, 'Sue', "make_manager_method_from_sql iterator 6 - $db_type"); $method = MySQLiteObjectManager->make_manager_method_from_sql( get_more => <<"EOF"); SELECT *, save + fk1 AS extra FROM rose_db_object_test WHERE id > ? ORDER BY id DESC EOF $objs = MySQLiteObjectManager->get_more(18); ok(scalar @$objs == 3, "make_manager_method_from_sql 9 - $db_type"); is($objs->[2]->id, 19, "make_manager_method_from_sql 10 - $db_type"); $method = MySQLiteObjectManager->make_manager_method_from_sql( method => 'get_more_np', params => [ qw(id name) ], sql => <<"EOF"); SELECT *, save + fk1 AS extra FROM rose_db_object_test WHERE id > ? AND name != ? ORDER BY id DESC EOF $objs = MySQLiteObjectManager->get_more_np(name => 'Nonesuch', id => 18); ok(scalar @$objs == 3, "make_manager_method_from_sql 11 - $db_type"); is($objs->[2]->id, 19, "make_manager_method_from_sql 12 - $db_type"); # End get_objects_from_sql tests # Start tough order tests $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', require_objects => [ 'nicks' ], nonlazy => 1); ok(@$objs == 5, "tough order 1 - $db_type"); is($objs->[0]->id, 2, "tough order 2 - $db_type"); is($objs->[1]->id, 5, "tough order 3 - $db_type"); is($objs->[2]->id, 10, "tough order 4 - $db_type"); is($objs->[3]->id, 11, "tough order 5 - $db_type"); is($objs->[4]->id, 12, "tough order 6 - $db_type"); $objs->[0]{'nicks'} = [ sort { $b->{'nick'} cmp $a->{'nick'} } @{$objs->[0]{'nicks'}} ]; is($objs->[0]{'nicks'}[0]{'nick'}, 'ntwo', "tough order 7 - $db_type"); is($objs->[0]{'nicks'}[1]{'nick'}, 'nfour', "tough order 8 - $db_type"); $objs->[1]{'nicks'} = [ sort { $b->{'nick'} cmp $a->{'nick'} } @{$objs->[1]{'nicks'}} ]; is($objs->[1]{'nicks'}[0]{'nick'}, 'nthree', "tough order 9 - $db_type"); is($objs->[1]{'nicks'}[1]{'nick'}, 'nsix', "tough order 10 - $db_type"); is($objs->[1]{'nicks'}[2]{'nick'}, 'none', "tough order 11 - $db_type"); is($objs->[1]{'nicks'}[3]{'nick'}, 'nfive', "tough order 12 - $db_type"); is($objs->[2]{'nicks'}[0]{'nick'}, 'nseven', "tough order 13 - $db_type"); is($objs->[3]{'nicks'}[0]{'nick'}, 'neight', "tough order 14 - $db_type"); is($objs->[4]{'nicks'}[0]{'nick'}, 'nnine', "tough order 15 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', require_objects => [ 'nicks' ], nonlazy => 1, sort_by => 'name'); ok(@$objs == 5, "tough order 16 - $db_type"); is($objs->[0]->id, 5, "tough order 17 - $db_type"); is($objs->[1]->id, 10, "tough order 18 - $db_type"); is($objs->[2]->id, 11, "tough order 19 - $db_type"); is($objs->[3]->id, 12, "tough order 20 - $db_type"); is($objs->[4]->id, 2, "tough order 21 - $db_type"); is($objs->[0]{'nicks'}[0]{'nick'}, 'nthree', "tough order 22 - $db_type"); is($objs->[0]{'nicks'}[1]{'nick'}, 'nsix', "tough order 23 - $db_type"); is($objs->[0]{'nicks'}[2]{'nick'}, 'none', "tough order 24 - $db_type"); is($objs->[0]{'nicks'}[3]{'nick'}, 'nfive', "tough order 25 - $db_type"); is(scalar @{$objs->[0]{'nicks'}}, 4, "tough order 26 - $db_type"); is($objs->[1]{'nicks'}[0]{'nick'}, 'nseven', "tough order 27 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 1, "tough order 28 - $db_type"); is($objs->[2]{'nicks'}[0]{'nick'}, 'neight', "tough order 29 - $db_type"); is(scalar @{$objs->[2]{'nicks'}}, 1, "tough order 30 - $db_type"); is($objs->[3]{'nicks'}[0]{'nick'}, 'nnine', "tough order 31 - $db_type"); is(scalar @{$objs->[3]{'nicks'}}, 1, "tough order 32 - $db_type"); is($objs->[4]{'nicks'}[0]{'nick'}, 'ntwo', "tough order 33 - $db_type"); is($objs->[4]{'nicks'}[1]{'nick'}, 'nfour', "tough order 34 - $db_type"); is(scalar @{$objs->[4]{'nicks'}}, 2, "tough order 35 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MySQLiteObject', require_objects => [ 'nicks' ], nonlazy => 1, sort_by => 'name'); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'nthree', "tough order 36 - $db_type"); is($o->{'nicks'}[1]{'nick'}, 'nsix', "tough order 37 - $db_type"); is($o->{'nicks'}[2]{'nick'}, 'none', "tough order 38 - $db_type"); is($o->{'nicks'}[3]{'nick'}, 'nfive', "tough order 39 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "tough order 40 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'nseven', "tough order 41 - $db_type"); is(scalar @{$o->{'nicks'}}, 1, "tough order 42 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'neight', "tough order 43 - $db_type"); is(scalar @{$o->{'nicks'}}, 1, "tough order 44 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'nnine', "tough order 45 - $db_type"); is(scalar @{$o->{'nicks'}}, 1, "tough order 46 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'ntwo', "tough order 47 - $db_type"); is($o->{'nicks'}[1]{'nick'}, 'nfour', "tough order 48 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "tough order 49 - $db_type"); ok(!$iterator->next, "tough order 50 - $db_type"); is($iterator->total, 5, "tough order 51 - $db_type"); # End tough order tests # Start deep join tests eval { Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', require_objects => [ 'nicks.type' ], with_objects => [ 'nicks.type' ]); }; ok($@, "deep join conflict 1 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', require_objects => [ 'nicks.type', 'nicks.type', 'nicks' ], with_objects => [ 'nicks.type.t2', 'nicks.alts' ], multi_many_ok => 1, query => [ 'id' => [ 2, 5 ] ], sort_by => 'type.name'); ok(@$objs == 2, "deep join 1 - $db_type"); is($objs->[0]->id, 2, "deep join 2 - $db_type"); is($objs->[1]->id, 5, "deep join 3 - $db_type"); is($objs->[0]{'nicks'}[0]{'type'}{'name'}, 'nt four', "deep join 4 - $db_type"); is($objs->[0]{'nicks'}[1]{'type'}{'name'}, 'nt two', "deep join 5 - $db_type"); is(scalar @{$objs->[0]{'nicks'}}, 2, "deep join 6 - $db_type"); is($objs->[1]{'nicks'}[0]{'type'}{'name'}, 'nt five', "deep join 7 - $db_type"); is($objs->[1]{'nicks'}[1]{'type'}{'name'}, 'nt one', "deep join 8 - $db_type"); is($objs->[1]{'nicks'}[2]{'type'}{'name'}, 'nt six', "deep join 9 - $db_type"); is($objs->[1]{'nicks'}[3]{'type'}{'name'}, 'nt three', "deep join 10 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 4, "deep join 11 - $db_type"); is($objs->[0]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join 12 - $db_type"); is($objs->[0]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join 13 - $db_type"); is($objs->[0]{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt two 1', "deep join 14 - $db_type"); $objs->[1]{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$objs->[1]{'nicks'}[1]{'alts'}} ]; is($objs->[1]{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt one 1', "deep join 15 - $db_type"); is($objs->[1]{'nicks'}[1]{'alts'}[1]{'alt'}, 'alt one 2', "deep join 16 - $db_type"); is($objs->[1]{'nicks'}[1]{'alts'}[2]{'alt'}, 'alt one 3', "deep join 17 - $db_type"); is(scalar @{$objs->[1]{'nicks'}[1]{'alts'}}, 3, "deep join 18 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', with_objects => [ 'nicks.type' ], nonlazy => 1, sort_by => 'type.name'); ok(@$objs == 21, "deep join with 1 - $db_type"); is($objs->[0]->id, 1, "deep join with 2 - $db_type"); is($objs->[1]->id, 2, "deep join with 3 - $db_type"); is($objs->[2]->id, 3, "deep join with 4 - $db_type"); is($objs->[16]->id, 17, "deep join with 5 - $db_type"); SORT: { $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; } is($objs->[1]{'nicks'}[0]{'type'}{'name'}, 'nt four', "deep join with 6 - $db_type"); is($objs->[1]{'nicks'}[1]{'type'}{'name'}, 'nt two', "deep join with 7 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 2, "deep join with 8 - $db_type"); SORT: { $objs->[4]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[4]{'nicks'}} ]; } is($objs->[4]{'nicks'}[0]{'type'}{'name'}, 'nt five', "deep join with 9 - $db_type"); is($objs->[4]{'nicks'}[1]{'type'}{'name'}, 'nt one', "deep join with 10 - $db_type"); is($objs->[4]{'nicks'}[2]{'type'}{'name'}, 'nt six', "deep join with 11 - $db_type"); is($objs->[4]{'nicks'}[3]{'type'}{'name'}, 'nt three', "deep join with 12 - $db_type"); is(scalar @{$objs->[4]{'nicks'}}, 4, "deep join with 13 - $db_type"); is(scalar @{$objs->[0]{'nicks'} ||= []}, 0, "deep join with 14 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MySQLiteObject', require_objects => [ 'nicks.type', 'nicks.type', 'nicks' ], with_objects => [ 'nicks.type.t2', 'nicks.alts' ], multi_many_ok => 1, query => [ 'id' => [ 2, 5 ] ], sort_by => 'type.name'); $o = $iterator->next; is($o->{'nicks'}[0]{'type'}{'name'}, 'nt four', "deep join iterator 1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'name'}, 'nt two', "deep join iterator 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "deep join iterator 3 - $db_type"); is($o->{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt two 1', "deep join 3.1 - $db_type"); is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join iterator 3.1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join iterator 3.2 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'type'}{'name'}, 'nt five', "deep join iterator 4 - $db_type"); is($o->{'nicks'}[1]{'type'}{'name'}, 'nt one', "deep join iterator 5 - $db_type"); is($o->{'nicks'}[2]{'type'}{'name'}, 'nt six', "deep join iterator 6 - $db_type"); is($o->{'nicks'}[3]{'type'}{'name'}, 'nt three', "deep join iterator 7 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "deep join iterator 8 - $db_type"); $o->{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$o->{'nicks'}[1]{'alts'}} ]; is($o->{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt one 1', "deep join iterator 9 - $db_type"); is($o->{'nicks'}[1]{'alts'}[1]{'alt'}, 'alt one 2', "deep join iterator 10 - $db_type"); is($o->{'nicks'}[1]{'alts'}[2]{'alt'}, 'alt one 3', "deep join iterator 11 - $db_type"); is(scalar @{$o->{'nicks'}[1]{'alts'}}, 3, "deep join iterator 12 - $db_type"); ok(!$iterator->next, "deep join iterator 13 - $db_type"); is($iterator->total, 2, "deep join iterator 14 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MySQLiteObject', with_objects => [ 'nicks.type' ], nonlazy => 1, sort_by => 'type.name'); $o = $iterator->next; is($o->id, 1, "deep join with with iterator 1 - $db_type"); $o = $iterator->next; SORT: { $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; } is($o->{'nicks'}[0]{'type'}{'name'}, 'nt four', "deep join with with iterator 1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'name'}, 'nt two', "deep join with iterator 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "deep join with iterator 3 - $db_type"); $o = $iterator->next; $o = $iterator->next; $o = $iterator->next; SORT: { $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; } is($o->{'nicks'}[0]{'type'}{'name'}, 'nt five', "deep join with iterator 4 - $db_type"); is($o->{'nicks'}[1]{'type'}{'name'}, 'nt one', "deep join with iterator 5 - $db_type"); is($o->{'nicks'}[2]{'type'}{'name'}, 'nt six', "deep join with iterator 6 - $db_type"); is($o->{'nicks'}[3]{'type'}{'name'}, 'nt three', "deep join with iterator 7 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "deep join with iterator 8 - $db_type"); while($iterator->next) { } is($iterator->total, 21, "deep join iterator 9 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', require_objects => [ 'nicks.type.t2' ], query => [ 'id' => [ 2, 5 ] ], nonlazy => 1, sort_by => 'type.name'); ok(@$objs == 2, "deep join three-level 1 - $db_type"); is($objs->[0]->id, 2, "deep join three-level 2 - $db_type"); is($objs->[1]->id, 5, "deep join three-level 3 - $db_type"); SORT: { $objs->[0]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[0]{'nicks'}} ]; } is($objs->[0]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join three-level 4 - $db_type"); is($objs->[0]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join three-level 5 - $db_type"); is(scalar @{$objs->[0]{'nicks'}}, 2, "deep join three-level 6 - $db_type"); SORT: { $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; } is($objs->[1]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 five', "deep join three-level 7 - $db_type"); is($objs->[1]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 one', "deep join three-level 8 - $db_type"); is($objs->[1]{'nicks'}[2]{'type'}{'t2'}{'name'}, 'nt2 six', "deep join three-level 9 - $db_type"); is($objs->[1]{'nicks'}[3]{'type'}{'t2'}{'name'}, 'nt2 three', "deep join three-level 10 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 4, "deep join three-level 11 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', with_objects => [ 'nicks.type.t2' ], nonlazy => 1, sort_by => 'type.name'); ok(@$objs == 21, "deep join three-level 1 - $db_type"); is($objs->[0]->id, 1, "deep join three-level 2 - $db_type"); is($objs->[1]->id, 2, "deep join three-level 3 - $db_type"); is($objs->[4]->id, 5, "deep join three-level 4 - $db_type"); is($objs->[20]->id, 60, "deep join three-level 5 - $db_type"); SORT: { $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; } is($objs->[1]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join three-level 6 - $db_type"); is($objs->[1]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join three-level 7 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 2, "deep join three-level 8 - $db_type"); SORT: { $objs->[4]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[4]{'nicks'}} ]; } is($objs->[4]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 five', "deep join three-level 9 - $db_type"); is($objs->[4]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 one', "deep join three-level 10 - $db_type"); is($objs->[4]{'nicks'}[2]{'type'}{'t2'}{'name'}, 'nt2 six', "deep join three-level 11 - $db_type"); is($objs->[4]{'nicks'}[3]{'type'}{'t2'}{'name'}, 'nt2 three', "deep join three-level 12 - $db_type"); is(scalar @{$objs->[4]{'nicks'}}, 4, "deep join three-level 13 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MySQLiteObject', require_objects => [ 'nicks.type.t2' ], query => [ 'id' => [ 2, 5 ] ], sort_by => 'type.name'); $o = $iterator->next; is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join iterator 1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join iterator 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "deep join iterator 3 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 five', "deep join iterator 4 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 one', "deep join iterator 5 - $db_type"); is($o->{'nicks'}[2]{'type'}{'t2'}{'name'}, 'nt2 six', "deep join iterator 6 - $db_type"); is($o->{'nicks'}[3]{'type'}{'t2'}{'name'}, 'nt2 three', "deep join iterator 7 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "deep join iterator 8 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MySQLiteObject', with_objects => [ 'nicks.type.t2' ], nonlazy => 1, sort_by => 'type.name'); $o = $iterator->next; $o = $iterator->next; SORT: { $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; } is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join iterator with 1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join iterator with 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "deep join iterator with 3 - $db_type"); $o = $iterator->next; $o = $iterator->next; $o = $iterator->next; SORT: { $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; } is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 five', "deep join iterator with 4 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 one', "deep join iterator with 5 - $db_type"); is($o->{'nicks'}[2]{'type'}{'t2'}{'name'}, 'nt2 six', "deep join iterator with 6 - $db_type"); is($o->{'nicks'}[3]{'type'}{'t2'}{'name'}, 'nt2 three', "deep join iterator with 7 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "deep join iterator with 8 - $db_type"); while($iterator->next) { } is($iterator->total, 21, "deep join iterator with 9 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', require_objects => [ 'nicks.alts' ], multi_many_ok => 1, query => [ 'id' => [ 2, 5 ] ], sort_by => 'alts.alt'); ok(@$objs == 2, "deep join multi 1 - $db_type"); is($objs->[0]->id, 2, "deep join multi 2 - $db_type"); is($objs->[1]->id, 5, "deep join multi 3 - $db_type"); is($objs->[0]{'nicks'}[0]{'alts'}[0]{'alt'}, 'alt two 1', "deep join multi 4 - $db_type"); is(scalar @{$objs->[0]{'nicks'}[0]{'alts'}}, 1, "deep join multi 5 - $db_type"); is($objs->[1]{'nicks'}[0]{'alts'}[0]{'alt'}, 'alt one 1', "deep join multi 6 - $db_type"); is($objs->[1]{'nicks'}[0]{'alts'}[1]{'alt'}, 'alt one 2', "deep join multi 7 - $db_type"); is($objs->[1]{'nicks'}[0]{'alts'}[2]{'alt'}, 'alt one 3', "deep join multi 8 - $db_type"); is(scalar @{$objs->[1]{'nicks'}[0]{'alts'}}, 3, "deep join multi 11 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', with_objects => [ 'nicks.alts' ], multi_many_ok => 1, nonlazy => 1, sort_by => 'alts.alt'); ok(@$objs == 21, "deep join multi with 1 - $db_type"); is($objs->[1]->id, 2, "deep join multi with 2 - $db_type"); is($objs->[4]->id, 5, "deep join multi with 3 - $db_type"); SORT: { $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; $objs->[1]{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$objs->[1]{'nicks'}[1]{'alts'}} ]; } is($objs->[1]{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt two 1', "deep join multi with with 4 - $db_type"); is(scalar @{$objs->[1]{'nicks'}[1]{'alts'}}, 1, "deep join multi with 5 - $db_type"); SORT: { $objs->[4]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[4]{'nicks'}} ]; $objs->[4]{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$objs->[4]{'nicks'}[1]{'alts'}} ]; } is($objs->[4]{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt one 1', "deep join multi with 6 - $db_type"); is($objs->[4]{'nicks'}[1]{'alts'}[1]{'alt'}, 'alt one 2', "deep join multi with 7 - $db_type"); is($objs->[4]{'nicks'}[1]{'alts'}[2]{'alt'}, 'alt one 3', "deep join multi with 8 - $db_type"); is(scalar @{$objs->[4]{'nicks'}[1]{'alts'}}, 3, "deep join multi with 11 - $db_type"); is(scalar @{$objs->[0]{'nicks'} || []}, 0, "deep join multi with 12 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MySQLiteObject', require_objects => [ 'nicks.alts' ], multi_many_ok => 1, query => [ 'id' => [ 2, 5 ] ], sort_by => 'alts.alt'); $o = $iterator->next; is($o->id, 2, "deep join multi iter 1 - $db_type"); is($o->{'nicks'}[0]{'alts'}[0]{'alt'}, 'alt two 1', "deep join multi iter 2 - $db_type"); is(scalar @{$o->{'nicks'}[0]{'alts'}}, 1, "deep join multi iter 3 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'alts'}[0]{'alt'}, 'alt one 1', "deep join multi iter 4 - $db_type"); is($o->{'nicks'}[0]{'alts'}[1]{'alt'}, 'alt one 2', "deep join multi iter 5 - $db_type"); is($o->{'nicks'}[0]{'alts'}[2]{'alt'}, 'alt one 3', "deep join multi iter 6 - $db_type"); is(scalar @{$o->{'nicks'}[0]{'alts'}}, 3, "deep join multi iter 7 - $db_type"); ok(!$iterator->next, "deep join multi iter 8 - $db_type"); is($iterator->total, 2, "deep join multi iter 9 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MySQLiteObject', with_objects => [ 'nicks.alts' ], multi_many_ok => 1, nonlazy => [ 'nicks' ], #query => [ id => 2 ], sort_by => 'alts.alt'); $o = $iterator->next; is(scalar @{$o->{'nicks'} ||= []}, 0, "deep join multi iter with 1 - $db_type"); $o = $iterator->next; SORT: { $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; $o->{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$o->{'nicks'}[1]{'alts'}} ]; } is($o->id, 2, "deep join multi iter with 2 - $db_type"); is($o->{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt two 1', "deep join multi iter with 3 - $db_type"); is(scalar @{$o->{'nicks'}[1]{'alts'}}, 1, "deep join multi iter with 4 - $db_type"); $o = $iterator->next; $o = $iterator->next; $o = $iterator->next; SORT: { $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; $o->{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$o->{'nicks'}[1]{'alts'}} ]; } is($o->{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt one 1', "deep join multi iter with 5 - $db_type"); is($o->{'nicks'}[1]{'alts'}[1]{'alt'}, 'alt one 2', "deep join multi iter with 6 - $db_type"); is($o->{'nicks'}[1]{'alts'}[2]{'alt'}, 'alt one 3', "deep join multi iter with 7 - $db_type"); is(scalar @{$o->{'nicks'}[1]{'alts'}}, 3, "deep join multi iter with 8 - $db_type"); while($iterator->next) { } is($iterator->total, 21, "deep join multi iter with 9 - $db_type"); # End deep join tests # Start custom select tests my @selects = ( 't2.nick, id, t2.id, name, UPPER(name) AS derived, fk1', 't1.id, t2.nick, t2.id, t1.name, UPPER(name) AS derived, t1.fk1', 'rose_db_object_nicks.id, rose_db_object_test.id, rose_db_object_nicks.nick, rose_db_object_test.name, UPPER(name) AS derived', [ \q(t1.id + 0 AS id), qw(name t2.nick nicks.id), \q(UPPER(name) AS derived) ], [ qw(t2.nick t2.id t1.id t1.name), 'UPPER(name) AS derived' ], [ \q(UPPER(name) AS derived), qw(t2.id rose_db_object_nicks.nick rose_db_object_test.id rose_db_object_test.name) ], [ qw(rose_db_object_test.id rose_db_object_nicks.nick rose_db_object_test.name rose_db_object_nicks.id), 'UPPER(name) AS derived' ], [ qw(rose_db_object_test.id rose_db_object_test.name rose_db_object_nicks.nick t2.id), 'UPPER(name) AS derived' ], ); $i = 0; #local $Rose::DB::Object::Manager::Debug = 1; foreach my $select (@selects) { $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MySQLiteObject', select => $select, require_objects => [ 'nicks' ], query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->nicks->[0]->nick && !defined $o->nicks->[0]->type_id && !defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->nicks->[0]->nick && !defined $o->nicks->[0]->type_id && !defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; ok(!$iterator->next, "custom select $i - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', select => $select, require_objects => [ 'nicks' ], query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; ok($objs->[0]->id > 2 && defined $objs->[0]->name && defined $objs->[0]->nicks->[0]->nick && !defined $objs->[0]->nicks->[0]->type_id && !defined $objs->[0]->flag2 && $objs->[0]->derived eq 'DERIVED: ' . uc($objs->[0]->name), "custom select $i - $db_type"); $i++; ok($objs->[1]->id > 2 && defined $objs->[1]->name && defined $objs->[1]->nicks->[0]->nick && !defined $objs->[1]->nicks->[0]->type_id && !defined $objs->[1]->flag2 && $objs->[1]->derived eq 'DERIVED: ' . uc($objs->[1]->name), "custom select $i - $db_type"); $i++; is(scalar @$objs, 2, "custom select $i - $db_type"); } @selects = ( 't2.nick, t1.*, t2.id, name, UPPER(name) AS derived', [ qw(t2.nick t2.id t1.*), 'UPPER(name) AS derived' ], ); #local $Rose::DB::Object::Manager::Debug = 1; foreach my $select (@selects) { $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MySQLiteObject', select => $select, require_objects => [ 'nicks' ], query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->nicks->[0]->nick && !defined $o->nicks->[0]->type_id && defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->nicks->[0]->nick && !defined $o->nicks->[0]->type_id && defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; ok(!$iterator->next, "custom select $i - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', select => $select, require_objects => [ 'nicks' ], query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; ok($objs->[0]->id > 2 && defined $objs->[0]->name && defined $objs->[0]->nicks->[0]->nick && !defined $objs->[0]->nicks->[0]->type_id && defined $objs->[0]->flag2 && $objs->[0]->derived eq 'DERIVED: ' . uc($objs->[0]->name), "custom select $i - $db_type"); $i++; ok($objs->[1]->id > 2 && defined $objs->[1]->name && defined $objs->[1]->nicks->[0]->nick && !defined $objs->[1]->nicks->[0]->type_id && defined $objs->[1]->flag2 && $objs->[1]->derived eq 'DERIVED: ' . uc($objs->[1]->name), "custom select $i - $db_type"); $i++; is(scalar @$objs, 2, "custom select $i - $db_type"); } @selects = ( '*, name, UPPER(name) AS derived', [ '*', 'UPPER(name) AS derived' ], ); #local $Rose::DB::Object::Manager::Debug = 1; foreach my $select (@selects) { $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MySQLiteObject', select => $select, query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; ok(!$iterator->next, "custom select $i - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', select => $select, query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; ok($objs->[0]->id > 2 && defined $objs->[0]->name && defined $objs->[0]->flag2 && $objs->[0]->derived eq 'DERIVED: ' . uc($objs->[0]->name), "custom select $i - $db_type"); $i++; ok($objs->[1]->id > 2 && defined $objs->[1]->name && defined $objs->[1]->flag2 && $objs->[1]->derived eq 'DERIVED: ' . uc($objs->[1]->name), "custom select $i - $db_type"); $i++; is(scalar @$objs, 2, "custom select $i - $db_type"); } # End custom select tests } # # Oracle # SKIP: foreach my $db_type (qw(oracle)) { skip("Oracle tests", 782) unless($HAVE_ORACLE); Rose::DB->default_type($db_type); my $o = MyOracleObject->new(id => 1, name => 'John', flag => 't', flag2 => 'f', fkone => 2, status => 'active', bits => '00001', start_date => '2001-01-02', save_col => 5, last_modified => 'now', date_created => '2004-03-30 12:34:56'); ok($o->save, "object save() 1 - $db_type"); my $objs = MyOracleObject->get_objectz( share_db => 1, query => [ id => { ge => 1 }, name => 'John', flag => 't', flag2 => 'f', status => 'active', bits => '00001', fixed => { like => 'nee%' }, or => [ and => [ '!bits' => '00001', bits => { ne => '11111' } ], and => [ bits => { lt => '10101' }, '!bits' => '10000' ] ], start_date => '01/02/2001', save_col => [ 1, 5 ], fk1 => 2, last_modified => { le => $o->last_modified }, date_created => '2004-03-30 12:34:56', date_created => { le => 'now' }, date_created => [ 'now', '2004-03-30 12:34:56' ], ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() 2 - $db_type"); my $o2 = $o->clone; $o2->id(2); $o2->name('Fred'); ok($o2->save, "object save() 2 - $db_type"); my $o3 = $o2->clone; $o3->id(3); $o3->name('Sue'); ok($o3->save, "object save() 3 - $db_type"); my $o4 = $o3->clone; $o4->id(4); $o4->name('Bob'); ok($o4->save, "object save() 4 - $db_type"); eval { $objs = MyOracleObjectManager->get_objectz( query => [ date_created => '205-1-2', # invalid date ]); }; ok($@, "Invalid date - $db_type"); eval { $objs = MyOracleObjectManager->get_objectz( query => [ flag => [] ]); }; ok($@, "Empty list 1 - $db_type"); $objs = MyOracleObjectManager->get_objectz( allow_empty_lists => 1, query => [ flag => [] ]); is(scalar @$objs, 4, "Empty list 2 - $db_type"); eval { $objs = MyOracleObjectManager->get_objectz( query => [ or => [ flag => 1, status => [] ] ]); }; ok($@, "Empty list 3 - $db_type"); $objs = MyOracleObjectManager->get_objectz( allow_empty_lists => 1, query => [ or => [ flag => 1, status => [] ] ]); is(scalar @$objs, 4, "Empty list 4 - $db_type"); $objs = MyOracleObjectManager->get_objectz( share_db => 1, query => [ id => { ge => 2 }, name => { like => '%e%' }, flag => 't', flag2 => 'f', status => 'active', bits => '00001', start_date => '01/02/2001', save_col => [ 1, 5 ], last_modified => { le => parse_date('now') }, date_created => '2004-03-30 12:34:56', status => { like => 'AC%', field => 'UPPER(status)' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'name DESC'); is(ref $objs, 'ARRAY', "get_objects() 3 - $db_type"); $objs ||= []; is(scalar @$objs, 2, "get_objects() 4 - $db_type"); is($objs->[0]->id, 3, "get_objects() 5 - $db_type"); is($objs->[1]->id, 2, "get_objects() 6 - $db_type"); my $count = MyOracleObject->get_objectz_count( share_db => 1, query => [ id => { ge => 2 }, name => { like => '%e%' }, flag => 't', flag2 => 'f', status => 'active', bits => '00001', start_date => '01/02/2001', save_col => [ 1, 5 ], last_modified => { le => parse_date('now') }, date_created => '2004-03-30 12:34:56', status => { like => 'AC%', field => 'UPPER(status)' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'name DESC'); is($count, 2, "get_objects_count() 1 - $db_type"); # Set up sub-object for this one test my $b1 = MyOracleBB->new(id => 1, name => 'one'); $b1->save; $objs->[0]->b1(1); $objs->[0]->save; $count = MyOracleObjectManager->get_objectz_count( share_db => 1, query_is_sql => 1, require_objects => [ 'bb1' ], query => [ 't2.name' => { like => 'o%' }, 't2_name' => { like => 'on%' }, 'bb1.name' => { like => '%n%' }, id => { ge => 2 }, name => { like => '%e%' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'name DESC'); is($count, 1, "get_objects_count() require 1 - $db_type"); # Clear sub-object $objs->[0]->b1(undef); $objs->[0]->save; $b1->delete; my $save_o = $o; my $iterator = MyOracleObjectManager->get_objectz_iterator( share_db => 1, query => [ id => { ge => 2 }, name => { like => '%e%' }, flag => 't', flag2 => 'f', status => 'active', bits => '00001', start_date => '01/02/2001', save_col => [ 1, 5 ], last_modified => { le => parse_date('now') }, date_created => '2004-03-30 12:34:56', status => { like => 'AC%', field => 'UPPER(status)' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'name'); is(ref $iterator, 'Rose::DB::Object::Iterator', "get_objects_iterator() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "iterator next() 1 - $db_type"); is($o->id, 2, "iterator next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Sue', "iterator next() 3 - $db_type"); is($o->id, 3, "iterator next() 4 - $db_type"); $o = $iterator->next; is($o, 0, "iterator next() 5 - $db_type"); is($iterator->total, 2, "iterator total() - $db_type"); $iterator = MyOracleObject->get_objectz_iterator( share_db => 1, skip_first => 1, query => [ id => { ge => 2 }, name => { like => '%e%' }, flag => 't', flag2 => 'f', status => 'active', bits => '00001', start_date => '01/02/2001', save_col => [ 1, 5 ], last_modified => { le => parse_date('now') }, date_created => '2004-03-30 12:34:56', status => { like => 'AC%', field => 'UPPER(status)' }, ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'name'); $o = $iterator->next; is($o->name, 'Sue', "iterator skip_first next() 1 - $db_type"); is($o->id, 3, "iterator skip_first next() 2 - $db_type"); $o = $iterator->next; is($o, 0, "iterator skip_first next() 3 - $db_type"); is($iterator->total, 1, "iterator total() - $db_type"); my $fo = MyOracleOtherObject->new(name => 'Foo 1', k1 => 1, k2 => 2, k3 => 3); ok($fo->save, "object save() 5 - $db_type"); $fo = MyOracleOtherObject->new(name => 'Foo 2', k1 => 2, k2 => 3, k3 => 4); ok($fo->save, "object save() 6 - $db_type"); $fo = MyOracleBB->new(id => 1, name => 'one'); ok($fo->save, "bb object save() 1 - $db_type"); $fo = MyOracleBB->new(id => 2, name => 'two'); ok($fo->save, "bb object save() 2 - $db_type"); $fo = MyOracleBB->new(id => 3, name => 'three'); ok($fo->save, "bb object save() 3 - $db_type"); $fo = MyOracleBB->new(id => 4, name => 'four'); ok($fo->save, "bb object save() 4 - $db_type"); my $o5 = MyOracleObject->new(id => 5, name => 'Betty', flag => 'f', flag2 => 't', status => 'with', bits => '10101', start_date => '2002-05-20', save_col => 123, fkone => 1, fk2 => 2, fk3 => 3, b1 => 2, b2 => 4, last_modified => '2001-01-10 20:34:56', date_created => '2002-05-10 10:34:56'); ok($o5->save, "object save() 7 - $db_type"); my $fo1; if(oracle_is_broken()) { SKIP: { skip("tests that trigger the dreaded ORA-00600 kpofdr-long error", 7) } } else { $fo1 = $o5->other_obj; ok($fo1 && ref $fo1 && $fo1->k1 == 1 && $fo1->k2 == 2 && $fo1->k3 == 3, "foreign object 1 - $db_type"); $fo1 = $o5->bb1; ok($fo1 && ref $fo1 && $fo1->id == 2, "bb foreign object 1 - $db_type"); $fo1 = $o5->bb2; ok($fo1 && ref $fo1 && $fo1->id == 4, "bb foreign object 2 - $db_type"); $objs = MyOracleObjectManager->get_objectz( share_db => 1, query => [ id => { ge => 2 }, name => { like => '%tt%' }, ], require_objects => [ 'other_obj' ]); ok(ref $objs->[0]->{'other_obj'} eq 'MyOracleOtherObject', "foreign object 2 - $db_type"); is($objs->[0]->other_obj->k2, 2, "foreign object 3 - $db_type"); is($objs->[0]->bb1->name, 'two', "bb foreign object 3 - $db_type"); is($objs->[0]->bb2->name, 'four', "bb foreign object 4 - $db_type"); } # Start "one to many" tests ok($fo = MyOracleNick->new(id => 1, o_id => 5, nick => 'none', type => { id => 1, name => 'nt one', t2 => { id => 1, name => 'nt2 one' } }, alts => [ { id => 1, alt => 'alt one 1' }, { id => 2, alt => 'alt one 2' }, { id => 3, alt => 'alt one 3' }, ], opts => [ { id => 1, opt => 'opt one 1' }, { id => 2, opt => 'opt one 2' } ])->save, "nick object save() 1 - $db_type"); $fo = MyOracleNick->new(id => 2, o_id => 2, nick => 'ntwo', type => { id => 2, name => 'nt two', t2 => { id => 2, name => 'nt2 two' } }, alts => [ { id => 4, alt => 'alt two 1' } ]); ok($fo->save, "nick object save() 2 - $db_type"); $fo = MyOracleNick->new(id => 3, o_id => 5, nick => 'nthree', type => { id => 3, name => 'nt three', t2 => { id => 3, name => 'nt2 three' } }, opts => [ { id => 3, opt => 'opt three 1' }, { id => 4, opt => 'opt three 2' } ]); ok($fo->save, "nick object save() 3 - $db_type"); $fo = MyOracleNick->new(id => 4, o_id => 2, nick => 'nfour', type => { id => 4, name => 'nt four', t2 => { id => 4, name => 'nt2 four' } }); ok($fo->save, "nick object save() 4 - $db_type"); $fo = MyOracleNick->new(id => 5, o_id => 5, nick => 'nfive', type => { id => 5, name => 'nt five', t2 => { id => 5, name => 'nt2 five' } }); ok($fo->save, "nick object save() 5 - $db_type"); $fo = MyOracleNick->new(id => 6, o_id => 5, nick => 'nsix', type => { id => 6, name => 'nt six', t2 => { id => 6, name => 'nt2 six' } }); ok($fo->save, "nick object save() 6 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; my $db = Rose::DB->new; $db->begin_work; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', db => $db, share_db => 1, with_objects => [ 'nicks' ], for_update => 1, lock => { on => [ qw(nicks.type_id flag) ], wait => 60, }, query => [ id => { ge => 1 }, 't1.name' => 'Betty', flag => 'f', flag2 => 1, bits => '10101', 't2.nick' => { like => 'n%' }, start_date => '5/20/2002', '!start_date' => { gt => DateTime->new(year => '2005', month => 12, day => 1) }, '!rose_db_object_test.start_date' => { gt => DateTime->new(year => '2005', month => 12, day => 2) }, '!t1.start_date' => { gt => DateTime->new(year => '2005', month => 12, day => 3) }, or => [], and => [], save_col => [ 1, 5, 123 ], fk1 => 1, last_modified => { le => '6/6/2020' }, # XXX: breaks in 2020! date_created => '5/10/2002 10:34:56 am' ], clauses => [ "LOWER(status) LIKE 'w%'" ], sort_by => 'id'); $db->commit; $db->begin_work; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', db => $db, share_db => 1, with_objects => [ 'nicks' ], for_update => 1, lock => { on => [ qw(nicks.type_id flag) ], skip_locked => 1, }, query => [ id => { ge => 1 }, 't1.name' => 'Betty', flag => 'f', flag2 => 1, bits => '10101', 't2.nick' => { like => 'n%' }, start_date => '5/20/2002', '!start_date' => { gt => DateTime->new(year => '2005', month => 12, day => 1) }, '!rose_db_object_test.start_date' => { gt => DateTime->new(year => '2005', month => 12, day => 2) }, '!t1.start_date' => { gt => DateTime->new(year => '2005', month => 12, day => 3) }, or => [], and => [], save_col => [ 1, 5, 123 ], fk1 => 1, last_modified => { le => '6/6/2020' }, # XXX: breaks in 2020! date_created => '5/10/2002 10:34:56 am' ], clauses => [ "LOWER(status) LIKE 'w%'" ], sort_by => 'id'); $db->commit; $db->begin_work; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', db => $db, share_db => 1, with_objects => [ 'nicks' ], lock => { type => 'for update', columns => [ qw(rose_db_object_nicks.type_id rose_db_object_test.flag), \q(save) ], nowait => 1, }, query => [ id => { ge => 1 }, 't1.name' => 'Betty', flag => 'f', flag2 => 1, bits => '10101', 't2.nick' => { like => 'n%' }, start_date => '5/20/2002', '!start_date' => { gt => DateTime->new(year => '2005', month => 12, day => 1) }, '!rose_db_object_test.start_date' => { gt => DateTime->new(year => '2005', month => 12, day => 2) }, '!t1.start_date' => { gt => DateTime->new(year => '2005', month => 12, day => 3) }, or => [], and => [], save_col => [ 1, 5, 123 ], fk1 => 1, last_modified => { le => '6/6/2020' }, # XXX: breaks in 2020! date_created => '5/10/2002 10:34:56 am' ], clauses => [ "LOWER(status) LIKE 'w%'" ], sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() with many 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() with many 2 - $db_type"); ok(!defined $objs->[0]->{'status'}, "lazy main 1 - $db_type"); is($objs->[0]->status, 'with', "lazy main 2 - $db_type"); my $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many 3 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many 4 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many 5 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many 6 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many 7 - $db_type"); $db->commit; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', share_db => 1, with_objects => [ 'bb2', 'nicks', 'bb1' ], query => [ 't1.id' => { ge => 1 }, 't1.name' => 'Betty', flag => 'f', flag2 => 1, bits => '10101', 't3.nick' => { like => 'n%' }, start_date => '5/20/2002', '!start_date' => { gt => DateTime->new(year => '2005', month => 12, day => 1) }, '!rose_db_object_test.start_date' => { gt => DateTime->new(year => '2005', month => 12, day => 2) }, '!t1.start_date' => { gt => DateTime->new(year => '2005', month => 12, day => 3) }, save_col => [ 1, 5, 123 ], fk1 => 1, last_modified => { le => '6/6/2020' }, # XXX: breaks in 2020! date_created => '5/10/2002 10:34:56 am' ], clauses => [ "LOWER(status) LIKE 'w%'" ], sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() with many 8 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() with many 9 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many 10 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many 11 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many 12 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many 13 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many 14 - $db_type"); $fo1 = $objs->[0]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects() with many bb1 1 - $db_type"); $fo1 = $objs->[0]->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects() with many bb2 2 - $db_type"); $iterator = MyOracleObjectManager->get_objectz_iterator( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], nonlazy => 1, sort_by => 't1.name'); is(ref $iterator, 'Rose::DB::Object::Iterator', "get_objects_iterator() 1 - $db_type"); $o = $iterator->next; is($o->name, 'Betty', "iterator many next() 1 - $db_type"); is($o->id, 5, "iterator many next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Bob', "iterator many next() 3 - $db_type"); is($o->id, 4, "iterator many next() 4 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "iterator many next() 5 - $db_type"); is($o->id, 2, "iterator many next() 6 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "iterator many sub-object 1 - $db_type"); is($o->{'nicks'}[0]{'nick'}, 'ntwo', "iterator many sub-object 2 - $db_type"); is($o->{'nicks'}[1]{'nick'}, 'nfour', "iterator many sub-object 3 - $db_type"); $o = $iterator->next; is($o->name, 'Sue', "iterator many next() 7 - $db_type"); is($o->id, 3, "iterator many next() 8 - $db_type"); $o = $iterator->next; is($o, 0, "iterator many next() 9 - $db_type"); is($iterator->total, 4, "iterator many total() - $db_type"); $iterator = MyOracleObjectManager->get_objectz_iterator( share_db => 1, with_objects => [ 'bb2', 'nicks' ], limit_with_subselect => 0, query => [ 't1.id' => { ge => 2 }, ], sort_by => 't1.name', limit => 2); $o = $iterator->next; is($o->name, 'Betty', "iterator limit 2 many next() 1 - $db_type"); is($o->id, 5, "iterator limit 2 many next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Bob', "iterator limit 2 many next() 3 - $db_type"); is($o->id, 4, "iterator limit 2 many next() 4 - $db_type"); $o = $iterator->next; is($o, 0, "iterator limit 2 many next() 5 - $db_type"); is($iterator->total, 2, "iterator limit 2 many total() - $db_type"); $iterator = MyOracleObjectManager->get_objectz_iterator( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], limit_with_subselect => 0, nonlazy => [ 'nicks' ], sort_by => 't1.name', limit => 3); $o = $iterator->next; is($o->name, 'Betty', "iterator limit 3 many next() 1 - $db_type"); is($o->id, 5, "iterator limit 3 many next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Bob', "iterator limit 3 many next() 3 - $db_type"); is($o->id, 4, "iterator limit 3 many next() 4 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "iterator limit 3 many next() 5 - $db_type"); is($o->id, 2, "iterator limit 3 many next() 6 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "iterator limit 3 many sub-object 1 - $db_type"); is($o->{'nicks'}[0]{'nick'}, 'ntwo', "iterator limit 3 many sub-object 2 - $db_type"); is($o->{'nicks'}[1]{'nick'}, 'nfour', "iterator limit 3 many sub-object 3 - $db_type"); $o = $iterator->next; is($o, 0, "iterator limit 3 many next() 7 - $db_type"); is($iterator->total, 3, "iterator limit 3 many total() - $db_type"); $objs = MyOracleObjectManager->get_objectz( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], limit_with_subselect => 0, sort_by => 't1.name', limit => 2); ok(ref $objs && @$objs == 2, "get_objects() limit 2 many 1 - $db_type"); is($objs->[0]->name, 'Betty', "get_objects() limit 2 many 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() limit 2 many 3 - $db_type"); is($objs->[1]->name, 'Bob', "get_objects() limit 2 many 4 - $db_type"); is($objs->[1]->id, 4, "get_objects() limit 2 many 5 - $db_type"); $objs = MyOracleObjectManager->get_objectz( share_db => 1, with_objects => [ 'nicks', 'bb2' ], query => [ 't1.id' => { ge => 2 }, ], limit_with_subselect => 0, nonlazy => 1, sort_by => 't1.name', limit => 3); ok(ref $objs && @$objs == 3, "get_objects() limit 3 many 1 - $db_type"); is($objs->[0]->name, 'Betty', "get_objects() limit 3 many 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() limit 3 many 3 - $db_type"); is($objs->[1]->name, 'Bob', "get_objects() limit 3 many 4 - $db_type"); is($objs->[1]->id, 4, "get_objects() limit 3 many 5 - $db_type"); is($objs->[2]->name, 'Fred', "get_objects() limit 3 many 6 - $db_type"); is($objs->[2]->id, 2, "get_objects() limit 3 many 7 - $db_type"); is(scalar @{$objs->[2]->{'nicks'}}, 2, 'get_objects() limit 3 many sub-object 1'); is($objs->[2]->{'nicks'}[0]{'nick'}, 'ntwo', 'get_objects() limit 3 many sub-object 2'); is($objs->[2]->{'nicks'}[1]{'nick'}, 'nfour', 'get_objects() limit 3 many sub-object 3'); $iterator = MyOracleObjectManager->get_objectz_iterator( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], limit_with_subselect => 0, nonlazy => 1, sort_by => 't1.name', limit => 2, offset => 1); $o = $iterator->next; is($o->name, 'Bob', "iterator limit 2 offset 1 many next() 1 - $db_type"); is($o->id, 4, "iterator limit 2 offset 1 many next() 2 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "iterator limit 2 offset 1 many next() 3 - $db_type"); is($o->id, 2, "iterator limit 2 offset 1 many next() 4 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, 'iterator limit 2 offset 1 many sub-object 1'); is($o->{'nicks'}[0]{'nick'}, 'ntwo', 'iterator limit 2 offset 1 many sub-object 2'); is($o->{'nicks'}[1]{'nick'}, 'nfour', 'iterator limit 2 offset 1 many sub-object 3'); $o = $iterator->next; is($o, 0, "iterator limit 2 offset 1 many next() 5 - $db_type"); is($iterator->total, 2, "iterator limit 2 offset 1 many total() - $db_type"); $iterator = MyOracleObjectManager->get_objectz_iterator( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], limit_with_subselect => 0, nonlazy => 1, sort_by => 't1.name', limit => 3, offset => 2); $o = $iterator->next; is($o->name, 'Fred', "iterator limit 3 offset 2 many next() 1 - $db_type"); is($o->id, 2, "iterator limit 3 offset 2 many next() 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, 'iterator limit 3 offset 2 many sub-object 1'); is($o->{'nicks'}[0]{'nick'}, 'ntwo', 'iterator limit 3 offset 2 many sub-object 2'); is($o->{'nicks'}[1]{'nick'}, 'nfour', 'iterator limit 3 offset 2 many sub-object 3'); $o = $iterator->next; is($o->name, 'Sue', "iterator limit 3 offset 2 many next() 3 - $db_type"); is($o->id, 3, "iterator limit 3 offset 2 many next() 4 - $db_type"); $o = $iterator->next; is($o, 0, "iterator limit 3 offset 2 many next() 5 - $db_type"); is($iterator->total, 2, "iterator limit 3 offset 2 many total() - $db_type"); $objs = MyOracleObjectManager->get_objectz( share_db => 1, with_objects => [ 'bb2', 'nicks' ], query => [ 't1.id' => { ge => 2 }, ], limit_with_subselect => 0, nonlazy => 1, sort_by => 't1.name', limit => 2, offset => 1); ok(ref $objs && @$objs == 2, "get_objects() limit 2 offset 1 many 1 - $db_type"); is($objs->[0]->name, 'Bob', "get_objects() limit 2 offset 1 many 2 - $db_type"); is($objs->[0]->id, 4, "get_objects() limit 2 offset 1 many 3 - $db_type"); is($objs->[1]->name, 'Fred', "get_objects() limit 2 offset 1 many 4 - $db_type"); is($objs->[1]->id, 2, "get_objects() limit 2 offset 1 many 5 - $db_type"); is(scalar @{$objs->[1]->{'nicks'}}, 2, 'get_objects() limit 2 offset 1 many sub-object 1'); is($objs->[1]->{'nicks'}[0]{'nick'}, 'ntwo', 'get_objects() limit 2 offset 1 many sub-object 2'); is($objs->[1]->{'nicks'}[1]{'nick'}, 'nfour', 'get_objects() limit 2 offset 1 many sub-object 3'); $objs = MyOracleObjectManager->get_objectz( share_db => 1, with_objects => [ 'nicks', 'bb2' ], query => [ 't1.id' => { ge => 2 }, ], limit_with_subselect => 0, nonlazy => 1, sort_by => 't1.name', limit => 3, offset => 2); ok(ref $objs && @$objs == 2, "get_objects() limit 3 offset 2 many 1 - $db_type"); is($objs->[0]->name, 'Fred', "get_objects() limit 3 offset 2 many 2 - $db_type"); is($objs->[0]->id, 2, "get_objects() limit 3 offset 2 many 3 - $db_type"); is(scalar @{$objs->[0]->{'nicks'}}, 2, 'get_objects() limit 3 offset 2 many sub-object 1'); is($objs->[0]->{'nicks'}[0]{'nick'}, 'ntwo', 'get_objects() limit 3 offset 2 many sub-object 2'); is($objs->[0]->{'nicks'}[1]{'nick'}, 'nfour', 'get_objects() limit 3 offset 2 many sub-object 3'); is($objs->[1]->name, 'Sue', "get_objects() limit 3 offset 2 many 4 - $db_type"); is($objs->[1]->id, 3, "get_objects() limit 3 offset 2 many 5 - $db_type"); my $o6 = $o2->clone; $o6->id(60); $o6->fkone(undef); $o6->fk2(undef); $o6->fk3(undef); $o6->b1(undef); $o6->b2(2); $o6->name('Ted'); ok($o6->save, "object save() 8 - $db_type"); my $o7 = $o2->clone; $o7->id(70); $o7->b1(3); $o7->b2(undef); $o7->name('Joe'); ok($o7->save, "object save() 9 - $db_type"); my $o8 = $o2->clone; $o8->id(80); $o8->b1(undef); $o8->b2(undef); $o8->name('Pete'); ok($o8->save, "object save() 10 - $db_type"); ok($fo->save, "object save() 10 - $db_type"); $fo = MyOracleNick->new(id => 7, o_id => 60, nick => 'nseven'); ok($fo->save, "nick object save() 7 - $db_type"); $fo = MyOracleNick->new(id => 8, o_id => 60, nick => 'neight'); ok($fo->save, "nick object save() 8 - $db_type"); $fo = MyOracleNick->new(id => 9, o_id => 60, nick => 'neight'); ok($fo->save, "nick object save() 8 - $db_type"); $fo = MyOracleNick2->new(id => 1, o_id => 5, nick2 => 'n2one'); ok($fo->save, "nick2 object save() 1 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', share_db => 1, require_objects => [ 'bb2', 'bb1' ], query => [ '!t1.id' => 5 ], sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() with many 15 - $db_type"); $objs ||= []; is(scalar @$objs, 0, "get_objects() with many 16 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( object_class => 'MyOracleObject', share_db => 1, require_objects => [ 'bb2', 'bb1' ], with_objects => [ 'nicks' ], query => [ ], sort_by => 't1.id'); is($count, 1, "get_objects_count() require 1 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; $count = Rose::DB::Object::Manager->get_objects_count( object_class => 'MyOracleObject', share_db => 1, require_objects => [ 'bb2' ], with_objects => [ 'nicks' ], query => [ ], sort_by => 't1.id'); is($count, 2, "get_objects_count() require 2 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', share_db => 1, require_objects => [ 'bb2', 'bb1' ], with_objects => [ 'nicks' ], query => [ ], sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() with many 17 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() with many 18 - $db_type"); is($objs->[0]->id, 5, "get_objects() with many 19 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many 20 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many 21 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many 22 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many 23 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many 24 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', share_db => 1, require_objects => [ 'bb1', 'bb2' ], with_objects => [ 'nicks2', 'nicks' ], multi_many_ok => 1, query => [ ], sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() with multi many 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() with multi many 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() with multi many 3 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with multi many 4 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with multi many 5 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with multi many 6 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with multi many 7 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with multi many 8 - $db_type"); is($objs->[0]->{'nicks2'}[0]{'nick2'}, 'n2one', "get_objects() with multi many 9 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyOracleObject', share_db => 1, require_objects => [ 'bb1', 'bb2' ], with_objects => [ 'nicks2', 'nicks' ], multi_many_ok => 1, query => [ ], sort_by => 't1.id'); $o = $iterator->next; is($o->name, 'Betty', "iterator with and require 1 - $db_type"); is($o->id, 5, "iterator with and require 2 - $db_type"); $nicks = $o->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "iterator with and require 3 - $db_type"); is($nicks->[0]->nick, 'nthree', "iterator with and require 4 - $db_type"); is($nicks->[1]->nick, 'nsix', "iterator with and require 5 - $db_type"); is($nicks->[2]->nick, 'none', "iterator with and require 6 - $db_type"); is($nicks->[3]->nick, 'nfive', "iterator with and require 7 - $db_type"); is($o->{'nicks2'}[0]{'nick2'}, 'n2one', "iterator with and require 8 - $db_type"); $o = $iterator->next; is($o, 0, "iterator with and require 9 - $db_type"); is($iterator->total, 1, "iterator with and require 10 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', share_db => 1, with_objects => [ 'bb2', 'nicks', 'bb1' ], query => [ ], sort_by => 't1.id'); is(ref $objs, 'ARRAY', "get_objects() with many 25 - $db_type"); $objs ||= []; is(scalar @$objs, 8, "get_objects() with many 26 - $db_type"); my $ids = join(',', map { $_->id } @$objs); is($ids, '1,2,3,4,5,60,70,80', "get_objects() with many 27 - $db_type"); $nicks = $objs->[4]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many 28 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many 29 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many 30 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many 31 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many 32 - $db_type"); is($objs->[6]->{'bb1'}->{'name'}, 'three', "get_objects() with many 33 - $db_type"); ok(!defined $objs->[6]->{'bb2'}, "get_objects() with many 34 - $db_type"); ok(!defined $objs->[6]->{'nicks'}, "get_objects() with many 35 - $db_type"); ok(!defined $objs->[7]->{'bb1'}, "get_objects() with many 36 - $db_type"); ok(!defined $objs->[7]->{'bb1'}, "get_objects() with many 37 - $db_type"); ok(!defined $objs->[7]->{'nicks'}, "get_objects() with many 38 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 0; $fo = MyOracleNick->new(id => 7); ok($fo->delete, "with many clean-up 1 - $db_type"); $fo = MyOracleNick->new(id => 8); ok($fo->delete, "with many clean-up 2 - $db_type"); $fo = MyOracleNick->new(id => 9); ok($fo->delete, "with many clean-up 3 - $db_type"); ok($o6->delete, "with many clean-up 4 - $db_type"); ok($o7->delete, "with many clean-up 5 - $db_type"); ok($o8->delete, "with many clean-up 6 - $db_type"); $fo = MyOracleNick2->new(id => 1); ok($fo->delete, "with many clean-up 7 - $db_type"); # End "one to many" tests if(oracle_is_broken()) { SKIP: { skip("tests that trigger the dreaded ORA-00600 kpofdr-long error", 4) } } else { $iterator = MyOracleObject->get_objectz_iterator( share_db => 1, query => [ 't1.id' => { ge => 2 }, 't1.name' => { like => '%tt%' }, ], require_objects => [ 'other_obj' ]); $o = $iterator->next; ok(ref $o->{'other_obj'} eq 'MyOracleOtherObject', "foreign object 4 - $db_type"); is($o->other_obj->k2, 2, "foreign object 5 - $db_type"); is($o->bb1->name, 'two', "bb foreign object 5 - $db_type"); is($o->bb2->name, 'four', "bb foreign object 6 - $db_type"); } $objs = MyOracleObjectManager->get_objectz( share_db => 1, query => [ id => { ge => 1 }, name => 'John', flag => 1, flag2 => 0, status => 'active', bits => '1', start_date => '1/2/2001', '!start_date' => { gt => DateTime->new(year => '2005', month => 1, day => 1) }, '!rose_db_object_test.start_date' => { gt => DateTime->new(year => '2005', month => 2, day => 2) }, '!t1.start_date' => { gt => DateTime->new(year => '2005', month => 3, day => 3) }, save_col => [ 1, 5 ], fk1 => 2, fk1 => { lt => 99 }, fk1 => { lt => 100 }, or => [ fk1 => { lt => 777 }, last_modified => '6/6/2020' ], last_modified => { le => '6/6/2020' }, # XXX: test breaks in 2020! date_created => '3/30/2004 12:34:56 pm' ], clauses => [ "LOWER(status) LIKE 'ac%'" ], limit => 5, sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() 7 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() 8 - $db_type"); $objs = MyOracleObject->get_objectz( share_db => 1, query => [ id => { ge => 2 }, k1 => { lt => 900 }, or => [ k1 => { ne => 99 }, k1 => 100 ], or => [ and => [ id => { ne => 123 }, id => { lt => 100 } ], and => [ id => { ne => 456 }, id => { lt => 300 } ] ], '!k2' => { gt => 999 }, '!t2.name' => 'z', start_date => { lt => DateTime->new(year => '2005', month => 1, day => 1) }, '!start_date' => { gt => DateTime->new(year => '2005', month => 1, day => 1) }, 'rose_db_object_test.name' => { like => '%tt%' }, '!rose_db_object_other.name' => 'q', '!rose_db_object_other.name' => [ 'x', 'y' ], ], require_objects => [ 'other_obj' ]); ok(ref $objs->[0]->{'other_obj'} eq 'MyOracleOtherObject', "foreign object 6 - $db_type"); is($objs->[0]->other_obj->k2, 2, "foreign object 7 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; $objs = MyOracleObjectManager->get_objectz( share_db => 1, queryis_sql => 1, query => [ id => { ge => 1 }, name => 'John', ], limit => 5, sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() 9 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() 10 - $db_type"); # Test limit with offset foreach my $id (6 .. 20) { my $o = $o5->clone; $o->id($id); $o->name("Clone $id"); ok($o->save, "object save() clone $id - $db_type"); } $objs = MyOracleObject->get_objectz( sort_by => 'id DESC', limit => 2, offset => 8); ok(ref $objs eq 'ARRAY' && @$objs == 2 && $objs->[0]->id == 12 && $objs->[1]->id == 11, "get_objects() with offset - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; $objs = MyOracleObjectManager->get_objectz( sort_by => 'id DESC', require_objects => [ 'other_obj' ], limit => 2, offset => 8); ok(ref $objs eq 'ARRAY' && @$objs == 2 && $objs->[0]->id == 12 && $objs->[1]->id == 11, "get_objects() with objects and offset - $db_type"); $iterator = MyOracleObject->get_objectz_iterator( sort_by => 'id DESC', limit => 2, offset => 8); $o = $iterator->next; is($o->id, 12, "get_objects_iterator() with offset 1 - $db_type"); $o = $iterator->next; is($o->id, 11, "get_objects_iterator() with offset 2 - $db_type"); is($iterator->next, 0, "get_objects_iterator() with offset 3 - $db_type"); eval { $objs = MyOracleObjectManager->get_objectz( object_class => 'MyOracleObject', sort_by => 'id DESC', offset => 8) }; ok($@ =~ /invalid without a limit/, "get_objects() missing offset - $db_type"); eval { $iterator = MyOracleObject->get_objectz_iterator( object_class => 'MyOracleObject', sort_by => 'id DESC', offset => 8); }; ok($@ =~ /invalid without a limit/, "get_objects_iterator() missing offset - $db_type"); # Start *_sql comparison tests $o6->fk2(99); $o6->fk3(99); $o6->save; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', query => [ 'fk2' => { eq_sql => 'fk3' } ], sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq_sql 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() eq_sql 2 - $db_type"); is($objs->[0]->id, 60, "get_objects() eq_sql 3 - $db_type"); # End *_sql comparison tests # Start IN NULL tests if(oracle_is_broken()) { SKIP: { skip("tests that trigger the dreaded ORA-00600 kpofdr-long error", 3) } } else { #local $Rose::DB::Object::Manager::Debug = 1; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', query => [ id => [ undef, 60 ], '!id' => \'id + 1' ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() in null 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() in null 2 - $db_type"); is($objs->[0]->id, 60, "get_objects() in null 3 - $db_type"); } # End IN NULL tests # Start scalar ref tests #local $Rose::DB::Object::Manager::Debug = 1; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', query => [ 'fk2' => \'fk3' ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq ref 1 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() eq ref 2 - $db_type"); is($objs->[0]->id, 60, "get_objects() eq ref 3 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', query => [ 'fk2' => [ \'fk3' ] ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq ref 4 - $db_type"); $objs ||= []; is(scalar @$objs, 1, "get_objects() eq ref 5 - $db_type"); is($objs->[0]->id, 60, "get_objects() eq ref 6 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', query => [ 'fk2' => { ne => \'fk3' } ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq ref 7 - $db_type"); $objs ||= []; is(scalar @$objs, 16, "get_objects() eq ref 8 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', query => [ 'fk2' => { ne => [ \'fk3' ] } ], #' sort_by => 'id'); is(ref $objs, 'ARRAY', "get_objects() eq ref 9 - $db_type"); $objs ||= []; is(scalar @$objs, 16, "get_objects() eq ref 10 - $db_type"); # End scalar ref tests # Start "many to many" tests $fo = MyOracleColor->new(id => 1, name => 'Red'); $fo->save; $fo = MyOracleColor->new(id => 2, name => 'Green'); $fo->save; $fo = MyOracleColor->new(id => 3, name => 'Blue'); $fo->save; $fo = MyOracleColorMap->new(id => 1, object_id => $o2->id, color_id => 1); $fo->save; $fo = MyOracleColorMap->new(id => 2, object_id => $o2->id, color_id => 3); $fo->save; $o2->b1(4); $o2->b1(2); $o2->fkone(2); $o2->fk2(3); $o2->fk3(4); $o2->save; my @colors = $o2->colors; ok(@colors == 2 && $colors[0]->name eq 'Red' && $colors[1]->name eq 'Blue', "Fetch many to many 1 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', share_db => 1, with_objects => [ 'other_obj', 'bb2', 'nicks', 'bb1', 'colors' ], multi_many_ok => 1, with_map_records => 'map_record', query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); is(ref $objs, 'ARRAY', "get_objects() with many to many 1 - $db_type"); $objs ||= []; is(scalar @$objs, 3, "get_objects() with many to many 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() with many to many 3 - $db_type"); is($objs->[1]->id, 2, "get_objects() with many to many 4 - $db_type"); is($objs->[2]->id, 1, "get_objects() with many to many 5 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many to many 6 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many to many 7 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many to many 8 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many to many 9 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many to many 10 - $db_type"); $fo1 = $objs->[0]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects() with many to many 11 - $db_type"); $fo1 = $objs->[0]->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects() with many to many 12 - $db_type"); my $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() with many to many 13 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() with many to many 14 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects() with many to many 15 - $db_type"); is($colors->[0]->map_record->color_id, $colors->[0]->id, "map_record 1 - $db_type"); is($colors->[0]->map_record->object_id, $objs->[1]->id, "map_record 2 - $db_type"); is($colors->[1]->map_record->color_id, $colors->[1]->id, "map_record 3 - $db_type"); is($colors->[0]->map_record->object_id, $objs->[1]->id, "map_record 4 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyOracleObject', share_db => 1, with_objects => [ 'other_obj', 'bb2', 'nicks', 'bb1', 'colors' ], multi_many_ok => 1, with_map_records => 'map_record', query => [ id => [ 1, 2, 5 ] ], sort_by => 't1.name'); $objs = []; while(my $obj = $iterator->next) { push(@$objs, $obj); } is(ref $objs, 'ARRAY', "get_objects_iterator() with many to many map record 1 - $db_type"); is(scalar @$objs, 3, "get_objects_iterator() with many to many map record 2 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db is($colors->[0]->map_record->color_id, $colors->[0]->id, "map_record 5 - $db_type"); is($colors->[0]->map_record->object_id, $objs->[1]->id, "map_record 6 - $db_type"); is($colors->[1]->map_record->color_id, $colors->[1]->id, "map_record 7 - $db_type"); is($colors->[0]->map_record->object_id, $objs->[1]->id, "map_record 8 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', share_db => 1, with_objects => [ 'other_obj', 'bb2', 'nicks', 'bb1', 'colors' ], multi_many_ok => 1, with_map_records => 'map_rec', query => [ id => [ 1, 2, 5 ] ], sort_by => 't1.name'); is(ref $objs, 'ARRAY', "get_objects() with many to many 1 - $db_type"); $objs ||= []; is(scalar @$objs, 3, "get_objects() with many to many 2 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db is($colors->[0]->map_rec->color_id, $colors->[0]->id, "map_rec 1 - $db_type"); is($colors->[0]->map_rec->object_id, $objs->[1]->id, "map_rec 2 - $db_type"); is($colors->[1]->map_rec->color_id, $colors->[1]->id, "map_rec 3 - $db_type"); is($colors->[0]->map_rec->object_id, $objs->[1]->id, "map_rec 4 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', share_db => 1, with_objects => [ 'bb1', 'nicks', 'other_obj', 'colors', 'bb2' ], multi_many_ok => 1, query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); is(ref $objs, 'ARRAY', "get_objects() with many to many (reorder) 1 - $db_type"); $objs ||= []; is(scalar @$objs, 3, "get_objects() with many to many (reorder) 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() with many to many (reorder) 3 - $db_type"); is($objs->[1]->id, 2, "get_objects() with many to many (reorder) 4 - $db_type"); is($objs->[2]->id, 1, "get_objects() with many to many (reorder) 5 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many to many (reorder) 6 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many to many (reorder) 7 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many to many (reorder) 8 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many to many (reorder) 9 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many to many (reorder) 10 - $db_type"); $fo1 = $objs->[0]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects() with many to many (reorder) 11 - $db_type"); $fo1 = $objs->[0]->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects() with many to many (reorder) 12 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() with many to many (reorder) 13 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() with many to many (reorder) 14 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects() with many to many (reorder) 15 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', share_db => 1, with_objects => [ 'nicks', 'colors', 'bb2' ], multi_many_ok => 1, require_objects => [ 'bb1', 'other_obj' ], query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); is(ref $objs, 'ARRAY', "get_objects() with many to many require with 1 - $db_type"); $objs ||= []; is(scalar @$objs, 2, "get_objects() with many to many require with 2 - $db_type"); is($objs->[0]->id, 5, "get_objects() with many to many require with 3 - $db_type"); is($objs->[1]->id, 2, "get_objects() with many to many require with 4 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() with many to many require with 6 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() with many to many 7 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() with many to many 8 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() with many to many 9 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() with many to many 10 - $db_type"); $fo1 = $objs->[0]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects() with many to many require with 11 - $db_type"); $fo1 = $objs->[0]->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects() with many to many require with 12 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() with many to many require with 13 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() with many to many require with 14 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects() with many to many require with 15 - $db_type"); $fo1 = $objs->[1]->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'two', "get_objects() with many to many require with 16 - $db_type"); $fo1 = $objs->[0]->{'other_obj'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'Foo 1', "get_objects() with many to many require with 17 - $db_type"); $fo1 = $objs->[1]->{'other_obj'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'Foo 2', "get_objects() with many to many require with 18 - $db_type"); ok(!defined $objs->[0]->{'colors'}, "get_objects() with many to many require with 19 - $db_type"); ok(!defined $objs->[1]->{'bb2'}, "get_objects() with many to many require with 20 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyOracleObject', share_db => 1, with_objects => [ 'other_obj', 'bb2', 'nicks', 'bb1', 'colors' ], multi_many_ok => 1, query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); $o = $iterator->next; is($o->name, 'Betty', "get_objects_iterator() with many to many 1 - $db_type"); is($o->id, 5, "get_objects_iterator() with many to many 2 - $db_type"); $nicks = $o->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects_iterator() with many to many 3 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects_iterator() with many to many 4 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects_iterator() with many to many 5 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects_iterator() with many to many 6 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects_iterator() with many to many 7 - $db_type"); $fo1 = $o->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects_iterator() with many to many 8 - $db_type"); $fo1 = $o->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects_iterator() with many to many 9 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "get_objects_iterator() with many to many 10 - $db_type"); is($o->id, 2, "get_objects_iterator() with many to many 11 - $db_type"); $colors = $o->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects_iterator() with many to many 12 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many 13 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many 14 - $db_type"); $o = $iterator->next; is($o->name, 'John', "get_objects_iterator() with many to many 15 - $db_type"); is($o->id, 1, "get_objects_iterator() with many to many 16 - $db_type"); $o = $iterator->next; is($o, 0, "get_objects_iterator() with many to many 17 - $db_type"); is($iterator->total, 3, "get_objects_iterator() with many to many 18 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyOracleObject', share_db => 1, with_objects => [ 'bb1', 'nicks', 'other_obj', 'colors', 'bb2' ], multi_many_ok => 1, query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); $o = $iterator->next; is($o->name, 'Betty', "get_objects_iterator() with many to many 19 - $db_type"); is($o->id, 5, "get_objects_iterator() with many to many 20 - $db_type"); $nicks = $o->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects_iterator() with many to many 21 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects_iterator() with many to many 22 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects_iterator() with many to many 23 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects_iterator() with many to many 24 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects_iterator() with many to many 25 - $db_type"); $fo1 = $o->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects_iterator() with many to many 26 - $db_type"); $fo1 = $o->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects_iterator() with many to many 27 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "get_objects_iterator() with many to many 28 - $db_type"); is($o->id, 2, "get_objects_iterator() with many to many 29 - $db_type"); $colors = $o->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects_iterator() with many to many 30 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many 31 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many 32 - $db_type"); $o = $iterator->next; is($o->name, 'John', "get_objects_iterator() with many to many 33 - $db_type"); is($o->id, 1, "get_objects_iterator() with many to many 34 - $db_type"); $o = $iterator->next; is($o, 0, "get_objects_iterator() with many to many 35 - $db_type"); is($iterator->total, 3, "get_objects_iterator() with many to many 36 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyOracleObject', share_db => 1, with_objects => [ 'nicks', 'colors', 'bb2' ], multi_many_ok => 1, require_objects => [ 'bb1', 'other_obj' ], query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name'); $o = $iterator->next; is($o->name, 'Betty', "get_objects_iterator() with many to many require 1 - $db_type"); is($o->id, 5, "get_objects_iterator() with many to many require 2 - $db_type"); $fo1 = $o->{'other_obj'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'Foo 1', "get_objects_iterator() with many to many require 3 - $db_type"); ok(!defined $o->{'colors'}, "get_objects_iterator() with many to many require 4 - $db_type"); $nicks = $o->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects_iterator() with many to many require 5 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects_iterator() with many to many require 6 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects_iterator() with many to many require 7 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects_iterator() with many to many require 8 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects_iterator() with many to many require 9 - $db_type"); $fo1 = $o->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 2, "get_objects_iterator() with many to many require 10 - $db_type"); $fo1 = $o->{'bb2'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->id == 4, "get_objects_iterator() with many to many require 11 - $db_type"); $o = $iterator->next; is($o->name, 'Fred', "get_objects_iterator() with many to many require 12 - $db_type"); is($o->id, 2, "get_objects_iterator() with many to many require 13 - $db_type"); $colors = $o->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects_iterator() with many to many require 14 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many require 15 - $db_type"); ok($colors->[1]->id == 3 && $colors->[0]->name eq 'Red', "get_objects_iterator() with many to many require 16 - $db_type"); $fo1 = $o->{'bb1'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'two', "get_objects_iterator() with many to many require 17 - $db_type"); $fo1 = $o->{'other_obj'}; # make sure this isn't hitting the db ok($fo1 && ref $fo1 && $fo1->name eq 'Foo 2', "get_objects_iterator() with many to many require 18 - $db_type"); ok(!defined $o->{'bb2'}, "get_objects_iterator() with many to many require 19 - $db_type"); $o = $iterator->next; is($o, 0, "get_objects_iterator() with many to many require 20 - $db_type"); is($iterator->total, 2, "get_objects_iterator() with many to many require 21 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyOracleObject', share_db => 1, with_objects => [ 'nicks', 'colors', 'bb2' ], multi_many_ok => 1, require_objects => [ 'bb1', 'other_obj' ], query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name', limit => 1, offset => 5); ok(!$iterator->next, "get_objects_iterator() with many to many require 22 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', share_db => 1, with_objects => [ 'nicks', 'colors', 'bb2' ], multi_many_ok => 1, require_objects => [ 'bb1', 'other_obj' ], query => [ 't1.id' => [ 1, 2, 5 ] ], sort_by => 't1.name', limit => 1, offset => 5); ok(@$objs == 0, "get_objects_iterator() with many to many require 23 - $db_type"); # End "many to many" tests # Start multi-require tests $fo = MyOracleColorMap->new(id => 3, object_id => 5, color_id => 2); $fo->save; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', share_db => 1, require_objects => [ 'nicks', 'colors', 'other_obj' ], multi_many_ok => 1, sort_by => 't1.name'); is(scalar @$objs, 2, "get_objects() multi many require 1 - $db_type"); is($objs->[0]->id, 5, "get_objects() multi many require 2 - $db_type"); is($objs->[1]->id, 2, "get_objects() multi many require 3 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() multi many require 4 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() multi many require 5 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() multi many require 6 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() multi many require 7 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() multi many require 8 - $db_type"); $colors = $objs->[0]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 1, "get_objects() multi many require 9 - $db_type"); ok($colors->[0]->id == 2 && $colors->[0]->name eq 'Green', "get_objects() multi many require 10 - $db_type"); $nicks = $objs->[1]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 2, "get_objects() multi many require 11 - $db_type"); is($nicks->[0]->nick, 'ntwo', "get_objects() multi many require 12 - $db_type"); is($nicks->[1]->nick, 'nfour', "get_objects() multi many require 13 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() multi many require 14 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() multi many require 15 - $db_type"); ok($colors->[1]->id == 3 && $colors->[1]->name eq 'Blue', "get_objects() multi many require 16 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', share_db => 1, require_objects => [ 'nicks', 'colors', 'other_obj' ], with_objects => [ 'bb2' ], multi_many_ok => 1, sort_by => 't1.name'); is(scalar @$objs, 2, "get_objects() multi many with require 1 - $db_type"); is($objs->[0]->id, 5, "get_objects() multi many with require 2 - $db_type"); is($objs->[1]->id, 2, "get_objects() multi many with require 3 - $db_type"); $nicks = $objs->[0]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 4, "get_objects() multi many with require 4 - $db_type"); is($nicks->[0]->nick, 'nthree', "get_objects() multi many with require 5 - $db_type"); is($nicks->[1]->nick, 'nsix', "get_objects() multi many with require 6 - $db_type"); is($nicks->[2]->nick, 'none', "get_objects() multi many with require 7 - $db_type"); is($nicks->[3]->nick, 'nfive', "get_objects() multi many with require 8 - $db_type"); $colors = $objs->[0]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 1, "get_objects() multi many with require 9 - $db_type"); ok($colors->[0]->id == 2 && $colors->[0]->name eq 'Green', "get_objects() multi many with require 10 - $db_type"); $nicks = $objs->[1]->{'nicks'}; # make sure this isn't hitting the db is(scalar @$nicks, 2, "get_objects() multi many with require 11 - $db_type"); is($nicks->[0]->nick, 'ntwo', "get_objects() multi many with require 12 - $db_type"); is($nicks->[1]->nick, 'nfour', "get_objects() multi many with require 13 - $db_type"); $colors = $objs->[1]->{'colors'}; # make sure this isn't hitting the db ok($colors && ref $colors && @$colors == 2, "get_objects() multi many with require 14 - $db_type"); ok($colors->[0]->id == 1 && $colors->[0]->name eq 'Red', "get_objects() multi many with require 15 - $db_type"); ok($colors->[1]->id == 3 && $colors->[1]->name eq 'Blue', "get_objects() multi many with require 16 - $db_type"); is($objs->[0]->{'bb2'}{'name'}, 'four', "get_objects() multi many with require 17 - $db_type"); ok(!defined $objs->[1]->{'bb2'}{'name'}, "get_objects() multi many with require 18 - $db_type"); MyOracleNick->new(id => 7, o_id => 10, nick => 'nseven')->save; MyOracleNick->new(id => 8, o_id => 11, nick => 'neight')->save; MyOracleNick->new(id => 9, o_id => 12, nick => 'nnine')->save; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', share_db => 1, require_objects => [ 'nicks', 'bb1' ], with_objects => [ 'colors' ], multi_many_ok => 1, sort_by => 't1.name'); is(scalar @$objs, 5, "get_objects() multi many with require map 1 - $db_type"); is($objs->[0]->id, 5, "get_objects() multi many with require map 2 - $db_type"); is($objs->[1]->id, 10, "get_objects() multi many with require map 3 - $db_type"); is($objs->[2]->id, 11, "get_objects() multi many with require map 4 - $db_type"); is($objs->[3]->id, 12, "get_objects() multi many with require map 5 - $db_type"); is($objs->[4]->id, 2, "get_objects() multi many with require map 6 - $db_type"); # End multi-require tests # Start distinct tests my $i = 0; foreach my $distinct (1, [ 't1' ], [ 'rose_db_object_test' ]) { $i++; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', distinct => $distinct, share_db => 1, require_objects => [ 'nicks', 'colors', 'other_obj' ], multi_many_ok => 1, sort_by => 't1.name'); is(scalar @$objs, 2, "get_objects() distinct multi many require $i.1 - $db_type"); is($objs->[0]->id, 5, "get_objects() distinct multi many require $i.2 - $db_type"); is($objs->[1]->id, 2, "get_objects() distinct multi many require $i.3 - $db_type"); ok(!defined $objs->[0]->{'nicks'}, "get_objects() distinct multi many require $i.4 - $db_type"); ok(!defined $objs->[0]->{'colors'}, "get_objects() distinct multi many require $i.5 - $db_type"); ok(!defined $objs->[1]->{'nicks'}, "get_objects() distinct multi many require $i.6 - $db_type"); ok(!defined $objs->[1]->{'colors'}, "get_objects() distinct multi many require $i.7 - $db_type"); } #local $Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; foreach my $distinct ([ 't2' ], [ 'rose_db_object_nicks' ], [ 'nicks' ]) { $i++; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', distinct => $distinct, share_db => 1, require_objects => [ 'nicks', 'colors', 'other_obj' ], multi_many_ok => 1, sort_by => 't1.name'); is(scalar @$objs, 2, "get_objects() distinct multi many require $i.1 - $db_type"); is($objs->[0]->id, 5, "get_objects() distinct multi many require $i.2 - $db_type"); is($objs->[1]->id, 2, "get_objects() distinct multi many require $i.3 - $db_type"); ok(defined $objs->[0]->{'nicks'}, "get_objects() distinct multi many require $i.4 - $db_type"); ok(!defined $objs->[0]->{'colors'}, "get_objects() distinct multi many require $i.5 - $db_type"); ok(defined $objs->[1]->{'nicks'}, "get_objects() distinct multi many require $i.6 - $db_type"); ok(!defined $objs->[1]->{'colors'}, "get_objects() distinct multi many require $i.7 - $db_type"); } # End distinct tests # Start pager tests is(Rose::DB::Object::Manager->default_objects_per_page, 20, 'default_objects_per_page 1'); Rose::DB::Object::Manager->default_objects_per_page(3); my $per_page = Rose::DB::Object::Manager->default_objects_per_page; $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 1, per_page => 3); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 1.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 1); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 2.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', query => [ id => { le => 11 } ], sort_by => 't1.id', per_page => 3); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 3.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', query => [ id => { le => 11 } ], sort_by => 't1.id', per_page => -1); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 4.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => -1); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 5.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => undef); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 6.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', query => [ id => { le => 11 } ], sort_by => 't1.id', per_page => undef); $i = 0; for(1 .. 3) { is($objs->[$i++]->id, $_, "pager 7.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', query => [ id => { le => 11 } ], sort_by => 't1.id'); ok(scalar @$objs > 3, "pager 8 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 2, per_page => 3); $i = 0; for(4 .. 6) { is($objs->[$i++]->id, $_, "pager 9.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 3, per_page => 3); $i = 0; for(7 .. 9) { is($objs->[$i++]->id, $_, "pager 10.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 4, per_page => 3); $i = 0; for(10 .. 11) { is($objs->[$i++]->id, $_, "pager 11.$_ - $db_type"); } $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', query => [ id => { le => 11 } ], sort_by => 't1.id', page => 5, per_page => 3); ok(scalar @$objs == 0, "pager 12 - $db_type"); Rose::DB::Object::Manager->default_objects_per_page(20); # End pager tests # Start get_objects_from_sql tests if(oracle_is_broken()) { SKIP: { skip("tests that trigger the dreaded ORA-00600 kpofdr-long error", 287) } } else { # local $Rose::DB::Object::Debug = 1; # local $Rose::DB::Object::Manager::Debug = 1; # $DB::single = 1; $objs = MyOracleObjectManager->get_objects_from_sql( db => MyOracleObject->init_db, object_class => 'MyOracleObject', prepare_cached => 1, sql => <<"EOF"); SELECT * FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF ok(scalar @$objs == 19, "get_objects_from_sql 1 - $db_type"); is($objs->[18]->id, 1, "get_objects_from_sql 2 - $db_type"); is($objs->[18]->save_col, 5, "get_objects_from_sql 3 - $db_type"); is($objs->[18]->name, 'John', "get_objects_from_sql 4 - $db_type"); $iterator = MyOracleObjectManager->get_objects_iterator_from_sql( db => MyOracleObject->init_db, object_class => 'MyOracleObject', prepare_cached => 1, sql => <<"EOF"); SELECT * FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF for(0 .. 17) { $iterator->next } $o = $iterator->next; is($o->id, 1, "get_objects_iterator_from_sql 1 - $db_type"); is($o->save_col, 5, "get_objects_iterator_from_sql 2 - $db_type"); is($o->name, 'John', "get_objects_iterator_from_sql 3 - $db_type"); ok(!$iterator->next, "get_objects_iterator_from_sql 4 - $db_type"); $objs = MyOracleObjectManager->get_objects_from_sql(<<"EOF"); SELECT * FROM rose_db_object_test WHERE id != fk1 ORDER BY id DESC EOF ok(scalar @$objs == 19, "get_objects_from_sql 5 - $db_type"); is($objs->[18]->id, 1, "get_objects_from_sql 6 - $db_type"); is($objs->[18]->save_col, 5, "get_objects_from_sql 7 - $db_type"); is($objs->[18]->name, 'John', "get_objects_from_sql 8 - $db_type"); $objs = MyOracleObjectManager->get_objects_from_sql( args => [ 19 ], sql => <<"EOF"); SELECT * FROM rose_db_object_test WHERE id > ? ORDER BY id DESC EOF ok(scalar @$objs == 2, "get_objects_from_sql 9 - $db_type"); is($objs->[0]->id, 60, "get_objects_from_sql 10 - $db_type"); my $method = MyOracleObjectManager->make_manager_method_from_sql( get_em => <<"EOF"); SELECT r.*, save + fk1 AS extra FROM rose_db_object_test r WHERE id != fk1 ORDER BY id DESC EOF $objs = MyOracleObjectManager->get_em; ok(scalar @$objs == 19, "make_manager_method_from_sql 1 - $db_type"); is($objs->[17]->id, 3, "make_manager_method_from_sql 2 - $db_type"); is($objs->[17]->extra, 7, "make_manager_method_from_sql 3 - $db_type"); is($objs->[17]->name, 'Sue', "make_manager_method_from_sql 4 - $db_type"); $objs = $method->('MyOracleObjectManager'); ok(scalar @$objs == 19, "make_manager_method_from_sql 5 - $db_type"); is($objs->[17]->id, 3, "make_manager_method_from_sql 6 - $db_type"); is($objs->[17]->extra, 7, "make_manager_method_from_sql 7 - $db_type"); is($objs->[17]->name, 'Sue', "make_manager_method_from_sql 8 - $db_type"); $method = MyOracleObjectManager->make_manager_method_from_sql( iterator => 1, method => 'iter_em', sql => <<"EOF"); SELECT r.*, save + fk1 AS extra FROM rose_db_object_test r WHERE id != fk1 ORDER BY id DESC EOF $iterator = MyOracleObjectManager->iter_em; for(0 .. 16) { $iterator->next } $o = $iterator->next; is($objs->[17]->id, 3, "make_manager_method_from_sql iterator 1 - $db_type"); is($objs->[17]->extra, 7, "make_manager_method_from_sql iterator 2 - $db_type"); is($objs->[17]->name, 'Sue', "make_manager_method_from_sql iterator 3 - $db_type"); $iterator = $method->('MyOracleObjectManager'); for(0 .. 16) { $iterator->next } $o = $iterator->next; is($objs->[17]->id, 3, "make_manager_method_from_sql iterator 4 - $db_type"); is($objs->[17]->extra, 7, "make_manager_method_from_sql iterator 5 - $db_type"); is($objs->[17]->name, 'Sue', "make_manager_method_from_sql iterator 6 - $db_type"); $method = MyOracleObjectManager->make_manager_method_from_sql( get_more => <<"EOF"); SELECT r.*, save + fk1 AS extra FROM rose_db_object_test r WHERE id > ? ORDER BY id DESC EOF $objs = MyOracleObjectManager->get_more(18); ok(scalar @$objs == 3, "make_manager_method_from_sql 9 - $db_type"); is($objs->[2]->id, 19, "make_manager_method_from_sql 10 - $db_type"); $method = MyOracleObjectManager->make_manager_method_from_sql( method => 'get_more_np', params => [ qw(id name) ], sql => <<"EOF"); SELECT r.*, save + fk1 AS extra FROM rose_db_object_test r WHERE id > ? AND name != ? ORDER BY id DESC EOF $objs = MyOracleObjectManager->get_more_np(name => 'Nonesuch', id => 18); ok(scalar @$objs == 3, "make_manager_method_from_sql 11 - $db_type"); is($objs->[2]->id, 19, "make_manager_method_from_sql 12 - $db_type"); # End get_objects_from_sql tests # Start tough order tests $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', require_objects => [ 'nicks' ], nonlazy => 1); ok(@$objs == 5, "tough order 1 - $db_type"); is($objs->[0]->id, 2, "tough order 2 - $db_type"); is($objs->[1]->id, 5, "tough order 3 - $db_type"); is($objs->[2]->id, 10, "tough order 4 - $db_type"); is($objs->[3]->id, 11, "tough order 5 - $db_type"); is($objs->[4]->id, 12, "tough order 6 - $db_type"); is($objs->[0]{'nicks'}[0]{'nick'}, 'ntwo', "tough order 7 - $db_type"); is($objs->[0]{'nicks'}[1]{'nick'}, 'nfour', "tough order 8 - $db_type"); is($objs->[1]{'nicks'}[0]{'nick'}, 'nthree', "tough order 9 - $db_type"); is($objs->[1]{'nicks'}[1]{'nick'}, 'nsix', "tough order 10 - $db_type"); is($objs->[1]{'nicks'}[2]{'nick'}, 'none', "tough order 11 - $db_type"); is($objs->[1]{'nicks'}[3]{'nick'}, 'nfive', "tough order 12 - $db_type"); is($objs->[2]{'nicks'}[0]{'nick'}, 'nseven', "tough order 13 - $db_type"); is($objs->[3]{'nicks'}[0]{'nick'}, 'neight', "tough order 14 - $db_type"); is($objs->[4]{'nicks'}[0]{'nick'}, 'nnine', "tough order 15 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', require_objects => [ 'nicks' ], nonlazy => 1, sort_by => 'name'); ok(@$objs == 5, "tough order 16 - $db_type"); is($objs->[0]->id, 5, "tough order 17 - $db_type"); is($objs->[1]->id, 10, "tough order 18 - $db_type"); is($objs->[2]->id, 11, "tough order 19 - $db_type"); is($objs->[3]->id, 12, "tough order 20 - $db_type"); is($objs->[4]->id, 2, "tough order 21 - $db_type"); is($objs->[0]{'nicks'}[0]{'nick'}, 'nthree', "tough order 22 - $db_type"); is($objs->[0]{'nicks'}[1]{'nick'}, 'nsix', "tough order 23 - $db_type"); is($objs->[0]{'nicks'}[2]{'nick'}, 'none', "tough order 24 - $db_type"); is($objs->[0]{'nicks'}[3]{'nick'}, 'nfive', "tough order 25 - $db_type"); is(scalar @{$objs->[0]{'nicks'}}, 4, "tough order 26 - $db_type"); is($objs->[1]{'nicks'}[0]{'nick'}, 'nseven', "tough order 27 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 1, "tough order 28 - $db_type"); is($objs->[2]{'nicks'}[0]{'nick'}, 'neight', "tough order 29 - $db_type"); is(scalar @{$objs->[2]{'nicks'}}, 1, "tough order 30 - $db_type"); is($objs->[3]{'nicks'}[0]{'nick'}, 'nnine', "tough order 31 - $db_type"); is(scalar @{$objs->[3]{'nicks'}}, 1, "tough order 32 - $db_type"); is($objs->[4]{'nicks'}[0]{'nick'}, 'ntwo', "tough order 33 - $db_type"); is($objs->[4]{'nicks'}[1]{'nick'}, 'nfour', "tough order 34 - $db_type"); is(scalar @{$objs->[4]{'nicks'}}, 2, "tough order 35 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyOracleObject', require_objects => [ 'nicks' ], nonlazy => 1, sort_by => 'name'); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'nthree', "tough order 36 - $db_type"); is($o->{'nicks'}[1]{'nick'}, 'nsix', "tough order 37 - $db_type"); is($o->{'nicks'}[2]{'nick'}, 'none', "tough order 38 - $db_type"); is($o->{'nicks'}[3]{'nick'}, 'nfive', "tough order 39 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "tough order 40 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'nseven', "tough order 41 - $db_type"); is(scalar @{$o->{'nicks'}}, 1, "tough order 42 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'neight', "tough order 43 - $db_type"); is(scalar @{$o->{'nicks'}}, 1, "tough order 44 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'nnine', "tough order 45 - $db_type"); is(scalar @{$o->{'nicks'}}, 1, "tough order 46 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'nick'}, 'ntwo', "tough order 47 - $db_type"); is($o->{'nicks'}[1]{'nick'}, 'nfour', "tough order 48 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "tough order 49 - $db_type"); ok(!$iterator->next, "tough order 50 - $db_type"); is($iterator->total, 5, "tough order 51 - $db_type"); # End tough order tests # Start deep join tests eval { Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', require_objects => [ 'nicks.type' ], with_objects => [ 'nicks.type' ]); }; ok($@, "deep join conflict 1 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', require_objects => [ 'nicks.type', 'nicks.type', 'nicks' ], with_objects => [ 'nicks.type.t2', 'nicks.alts' ], multi_many_ok => 1, query => [ 'id' => [ 2, 5 ] ], sort_by => 'type.name'); ok(@$objs == 2, "deep join 1 - $db_type"); is($objs->[0]->id, 2, "deep join 2 - $db_type"); is($objs->[1]->id, 5, "deep join 3 - $db_type"); is($objs->[0]{'nicks'}[0]{'type'}{'name'}, 'nt four', "deep join 4 - $db_type"); is($objs->[0]{'nicks'}[1]{'type'}{'name'}, 'nt two', "deep join 5 - $db_type"); is(scalar @{$objs->[0]{'nicks'}}, 2, "deep join 6 - $db_type"); is($objs->[1]{'nicks'}[0]{'type'}{'name'}, 'nt five', "deep join 7 - $db_type"); is($objs->[1]{'nicks'}[1]{'type'}{'name'}, 'nt one', "deep join 8 - $db_type"); is($objs->[1]{'nicks'}[2]{'type'}{'name'}, 'nt six', "deep join 9 - $db_type"); is($objs->[1]{'nicks'}[3]{'type'}{'name'}, 'nt three', "deep join 10 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 4, "deep join 11 - $db_type"); is($objs->[0]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join 12 - $db_type"); is($objs->[0]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join 13 - $db_type"); is($objs->[0]{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt two 1', "deep join 14 - $db_type"); $objs->[1]{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$objs->[1]{'nicks'}[1]{'alts'}} ]; is($objs->[1]{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt one 1', "deep join 15 - $db_type"); is($objs->[1]{'nicks'}[1]{'alts'}[1]{'alt'}, 'alt one 2', "deep join 16 - $db_type"); is($objs->[1]{'nicks'}[1]{'alts'}[2]{'alt'}, 'alt one 3', "deep join 17 - $db_type"); is(scalar @{$objs->[1]{'nicks'}[1]{'alts'}}, 3, "deep join 18 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', with_objects => [ 'nicks.type' ], nonlazy => 1, sort_by => 'type.name'); ok(@$objs == 21, "deep join with 1 - $db_type"); is($objs->[0]->id, 1, "deep join with 2 - $db_type"); is($objs->[1]->id, 2, "deep join with 3 - $db_type"); is($objs->[2]->id, 3, "deep join with 4 - $db_type"); is($objs->[16]->id, 17, "deep join with 5 - $db_type"); #SORT: #{ # $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; #} is($objs->[1]{'nicks'}[0]{'type'}{'name'}, 'nt four', "deep join with 6 - $db_type"); is($objs->[1]{'nicks'}[1]{'type'}{'name'}, 'nt two', "deep join with 7 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 2, "deep join with 8 - $db_type"); #SORT: #{ # $objs->[4]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[4]{'nicks'}} ]; #} is($objs->[4]{'nicks'}[0]{'type'}{'name'}, 'nt five', "deep join with 9 - $db_type"); is($objs->[4]{'nicks'}[1]{'type'}{'name'}, 'nt one', "deep join with 10 - $db_type"); is($objs->[4]{'nicks'}[2]{'type'}{'name'}, 'nt six', "deep join with 11 - $db_type"); is($objs->[4]{'nicks'}[3]{'type'}{'name'}, 'nt three', "deep join with 12 - $db_type"); is(scalar @{$objs->[4]{'nicks'}}, 4, "deep join with 13 - $db_type"); is(scalar @{$objs->[0]{'nicks'} ||= []}, 0, "deep join with 14 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyOracleObject', require_objects => [ 'nicks.type', 'nicks.type', 'nicks' ], with_objects => [ 'nicks.type.t2', 'nicks.alts' ], multi_many_ok => 1, query => [ 'id' => [ 2, 5 ] ], sort_by => 'type.name'); $o = $iterator->next; is($o->{'nicks'}[0]{'type'}{'name'}, 'nt four', "deep join iterator 1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'name'}, 'nt two', "deep join iterator 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "deep join iterator 3 - $db_type"); is($o->{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt two 1', "deep join 3.1 - $db_type"); is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join iterator 3.1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join iterator 3.2 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'type'}{'name'}, 'nt five', "deep join iterator 4 - $db_type"); is($o->{'nicks'}[1]{'type'}{'name'}, 'nt one', "deep join iterator 5 - $db_type"); is($o->{'nicks'}[2]{'type'}{'name'}, 'nt six', "deep join iterator 6 - $db_type"); is($o->{'nicks'}[3]{'type'}{'name'}, 'nt three', "deep join iterator 7 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "deep join iterator 8 - $db_type"); $o->{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$o->{'nicks'}[1]{'alts'}} ]; is($o->{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt one 1', "deep join iterator 9 - $db_type"); is($o->{'nicks'}[1]{'alts'}[1]{'alt'}, 'alt one 2', "deep join iterator 10 - $db_type"); is($o->{'nicks'}[1]{'alts'}[2]{'alt'}, 'alt one 3', "deep join iterator 11 - $db_type"); is(scalar @{$o->{'nicks'}[1]{'alts'}}, 3, "deep join iterator 12 - $db_type"); ok(!$iterator->next, "deep join iterator 13 - $db_type"); is($iterator->total, 2, "deep join iterator 14 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyOracleObject', with_objects => [ 'nicks.type' ], nonlazy => 1, sort_by => 'type.name'); $o = $iterator->next; is($o->id, 1, "deep join with with iterator 1 - $db_type"); $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; #} is($o->{'nicks'}[0]{'type'}{'name'}, 'nt four', "deep join with with iterator 1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'name'}, 'nt two', "deep join with iterator 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "deep join with iterator 3 - $db_type"); $o = $iterator->next; $o = $iterator->next; $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; #} is($o->{'nicks'}[0]{'type'}{'name'}, 'nt five', "deep join with iterator 4 - $db_type"); is($o->{'nicks'}[1]{'type'}{'name'}, 'nt one', "deep join with iterator 5 - $db_type"); is($o->{'nicks'}[2]{'type'}{'name'}, 'nt six', "deep join with iterator 6 - $db_type"); is($o->{'nicks'}[3]{'type'}{'name'}, 'nt three', "deep join with iterator 7 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "deep join with iterator 8 - $db_type"); while($iterator->next) { } is($iterator->total, 21, "deep join iterator 9 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', require_objects => [ 'nicks.type.t2' ], query => [ 'id' => [ 2, 5 ] ], nonlazy => 1, sort_by => 'type.name'); ok(@$objs == 2, "deep join three-level 1 - $db_type"); is($objs->[0]->id, 2, "deep join three-level 2 - $db_type"); is($objs->[1]->id, 5, "deep join three-level 3 - $db_type"); #SORT: #{ # $objs->[0]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[0]{'nicks'}} ]; #} is($objs->[0]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join three-level 4 - $db_type"); is($objs->[0]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join three-level 5 - $db_type"); is(scalar @{$objs->[0]{'nicks'}}, 2, "deep join three-level 6 - $db_type"); #SORT: #{ # $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; #} is($objs->[1]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 five', "deep join three-level 7 - $db_type"); is($objs->[1]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 one', "deep join three-level 8 - $db_type"); is($objs->[1]{'nicks'}[2]{'type'}{'t2'}{'name'}, 'nt2 six', "deep join three-level 9 - $db_type"); is($objs->[1]{'nicks'}[3]{'type'}{'t2'}{'name'}, 'nt2 three', "deep join three-level 10 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 4, "deep join three-level 11 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', with_objects => [ 'nicks.type.t2' ], nonlazy => 1, sort_by => 'type.name'); ok(@$objs == 21, "deep join three-level 1 - $db_type"); is($objs->[0]->id, 1, "deep join three-level 2 - $db_type"); is($objs->[1]->id, 2, "deep join three-level 3 - $db_type"); is($objs->[4]->id, 5, "deep join three-level 4 - $db_type"); is($objs->[20]->id, 60, "deep join three-level 5 - $db_type"); #SORT: #{ # $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; #} is($objs->[1]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join three-level 6 - $db_type"); is($objs->[1]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join three-level 7 - $db_type"); is(scalar @{$objs->[1]{'nicks'}}, 2, "deep join three-level 8 - $db_type"); #SORT: #{ # $objs->[4]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[4]{'nicks'}} ]; #} is($objs->[4]{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 five', "deep join three-level 9 - $db_type"); is($objs->[4]{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 one', "deep join three-level 10 - $db_type"); is($objs->[4]{'nicks'}[2]{'type'}{'t2'}{'name'}, 'nt2 six', "deep join three-level 11 - $db_type"); is($objs->[4]{'nicks'}[3]{'type'}{'t2'}{'name'}, 'nt2 three', "deep join three-level 12 - $db_type"); is(scalar @{$objs->[4]{'nicks'}}, 4, "deep join three-level 13 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyOracleObject', require_objects => [ 'nicks.type.t2' ], query => [ 'id' => [ 2, 5 ] ], sort_by => 'type.name'); $o = $iterator->next; is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join iterator 1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join iterator 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "deep join iterator 3 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 five', "deep join iterator 4 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 one', "deep join iterator 5 - $db_type"); is($o->{'nicks'}[2]{'type'}{'t2'}{'name'}, 'nt2 six', "deep join iterator 6 - $db_type"); is($o->{'nicks'}[3]{'type'}{'t2'}{'name'}, 'nt2 three', "deep join iterator 7 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "deep join iterator 8 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyOracleObject', with_objects => [ 'nicks.type.t2' ], nonlazy => 1, sort_by => 'type.name'); $o = $iterator->next; $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; #} is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 four', "deep join iterator with 1 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 two', "deep join iterator with 2 - $db_type"); is(scalar @{$o->{'nicks'}}, 2, "deep join iterator with 3 - $db_type"); $o = $iterator->next; $o = $iterator->next; $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; #} is($o->{'nicks'}[0]{'type'}{'t2'}{'name'}, 'nt2 five', "deep join iterator with 4 - $db_type"); is($o->{'nicks'}[1]{'type'}{'t2'}{'name'}, 'nt2 one', "deep join iterator with 5 - $db_type"); is($o->{'nicks'}[2]{'type'}{'t2'}{'name'}, 'nt2 six', "deep join iterator with 6 - $db_type"); is($o->{'nicks'}[3]{'type'}{'t2'}{'name'}, 'nt2 three', "deep join iterator with 7 - $db_type"); is(scalar @{$o->{'nicks'}}, 4, "deep join iterator with 8 - $db_type"); while($iterator->next) { } is($iterator->total, 21, "deep join iterator with 9 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', require_objects => [ 'nicks.alts' ], multi_many_ok => 1, query => [ 'id' => [ 2, 5 ] ], sort_by => 'alts.alt'); ok(@$objs == 2, "deep join multi 1 - $db_type"); is($objs->[0]->id, 2, "deep join multi 2 - $db_type"); is($objs->[1]->id, 5, "deep join multi 3 - $db_type"); is($objs->[0]{'nicks'}[0]{'alts'}[0]{'alt'}, 'alt two 1', "deep join multi 4 - $db_type"); is(scalar @{$objs->[0]{'nicks'}[0]{'alts'}}, 1, "deep join multi 5 - $db_type"); is($objs->[1]{'nicks'}[0]{'alts'}[0]{'alt'}, 'alt one 1', "deep join multi 6 - $db_type"); is($objs->[1]{'nicks'}[0]{'alts'}[1]{'alt'}, 'alt one 2', "deep join multi 7 - $db_type"); is($objs->[1]{'nicks'}[0]{'alts'}[2]{'alt'}, 'alt one 3', "deep join multi 8 - $db_type"); is(scalar @{$objs->[1]{'nicks'}[0]{'alts'}}, 3, "deep join multi 11 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', with_objects => [ 'nicks.alts' ], multi_many_ok => 1, nonlazy => 1, sort_by => 'alts.alt DESC'); ok(@$objs == 21, "deep join multi with 1 - $db_type"); is($objs->[1]->id, 2, "deep join multi with 2 - $db_type"); is($objs->[4]->id, 5, "deep join multi with 3 - $db_type"); #SORT: #{ # $objs->[1]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[1]{'nicks'}} ]; # $objs->[1]{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$objs->[1]{'nicks'}[1]{'alts'}} ]; #} is($objs->[1]{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt two 1', "deep join multi with with 4 - $db_type"); is(scalar @{$objs->[1]{'nicks'}[1]{'alts'}}, 1, "deep join multi with 5 - $db_type"); #SORT: #{ # $objs->[4]{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$objs->[4]{'nicks'}} ]; # $objs->[4]{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$objs->[4]{'nicks'}[3]{'alts'}} ]; #} is($objs->[4]{'nicks'}[3]{'alts'}[0]{'alt'}, 'alt one 3', "deep join multi with 6 - $db_type"); is($objs->[4]{'nicks'}[3]{'alts'}[1]{'alt'}, 'alt one 2', "deep join multi with 7 - $db_type"); is($objs->[4]{'nicks'}[3]{'alts'}[2]{'alt'}, 'alt one 1', "deep join multi with 8 - $db_type"); is(scalar @{$objs->[4]{'nicks'}[3]{'alts'}}, 3, "deep join multi with 11 - $db_type"); is(scalar @{$objs->[0]{'nicks'} || []}, 0, "deep join multi with 12 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyOracleObject', require_objects => [ 'nicks.alts' ], multi_many_ok => 1, query => [ 'id' => [ 2, 5 ] ], sort_by => 'alts.alt'); $o = $iterator->next; is($o->id, 2, "deep join multi iter 1 - $db_type"); is($o->{'nicks'}[0]{'alts'}[0]{'alt'}, 'alt two 1', "deep join multi iter 2 - $db_type"); is(scalar @{$o->{'nicks'}[0]{'alts'}}, 1, "deep join multi iter 3 - $db_type"); $o = $iterator->next; is($o->{'nicks'}[0]{'alts'}[0]{'alt'}, 'alt one 1', "deep join multi iter 4 - $db_type"); is($o->{'nicks'}[0]{'alts'}[1]{'alt'}, 'alt one 2', "deep join multi iter 5 - $db_type"); is($o->{'nicks'}[0]{'alts'}[2]{'alt'}, 'alt one 3', "deep join multi iter 6 - $db_type"); is(scalar @{$o->{'nicks'}[0]{'alts'}}, 3, "deep join multi iter 7 - $db_type"); ok(!$iterator->next, "deep join multi iter 8 - $db_type"); is($iterator->total, 2, "deep join multi iter 9 - $db_type"); $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyOracleObject', with_objects => [ 'nicks.alts' ], multi_many_ok => 1, nonlazy => 1, #query => [ id => 2 ], sort_by => 'alts.alt DESC'); $o = $iterator->next; is(scalar @{$o->{'nicks'} ||= []}, 0, "deep join multi iter with 1 - $db_type"); $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; # $o->{'nicks'}[1]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$o->{'nicks'}[1]{'alts'}} ]; #} is($o->id, 2, "deep join multi iter with 2 - $db_type"); is($o->{'nicks'}[1]{'alts'}[0]{'alt'}, 'alt two 1', "deep join multi iter with 3 - $db_type"); is(scalar @{$o->{'nicks'}[1]{'alts'}}, 1, "deep join multi iter with 4 - $db_type"); $o = $iterator->next; $o = $iterator->next; $o = $iterator->next; #SORT: #{ # $o->{'nicks'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$o->{'nicks'}} ]; # $o->{'nicks'}[3]{'alts'} = [ sort { $a->{'alt'} cmp $b->{'alt'} } @{$o->{'nicks'}[3]{'alts'}} ]; #} is($o->{'nicks'}[3]{'alts'}[0]{'alt'}, 'alt one 3', "deep join multi iter with 5 - $db_type"); is($o->{'nicks'}[3]{'alts'}[1]{'alt'}, 'alt one 2', "deep join multi iter with 6 - $db_type"); is($o->{'nicks'}[3]{'alts'}[2]{'alt'}, 'alt one 1', "deep join multi iter with 7 - $db_type"); is(scalar @{$o->{'nicks'}[3]{'alts'}}, 3, "deep join multi iter with 8 - $db_type"); while($iterator->next) { } is($iterator->total, 21, "deep join multi iter with 9 - $db_type"); # End deep join tests # Start custom select tests my @selects = ( 't2.nick, id, t2.id, name, UPPER(name) AS derived, fk1', 't1.id, t2.nick, t2.id, t1.name, UPPER(name) AS derived, t1.fk1', 'rose_db_object_nicks.id, rose_db_object_test.id, rose_db_object_nicks.nick, rose_db_object_test.name, UPPER(name) AS derived', [ \q(t1.id + 0 AS id), qw(name t2.nick nicks.id), \q(UPPER(name) AS derived) ], [ qw(t2.nick t2.id t1.id t1.name), 'UPPER(name) AS derived' ], [ \q(UPPER(name) AS derived), qw(t2.id rose_db_object_nicks.nick rose_db_object_test.id rose_db_object_test.name) ], [ qw(rose_db_object_test.id rose_db_object_nicks.nick rose_db_object_test.name rose_db_object_nicks.id), 'UPPER(name) AS derived' ], [ qw(rose_db_object_test.id rose_db_object_test.name rose_db_object_nicks.nick t2.id), 'UPPER(name) AS derived' ], ); $i = 0; #local $Rose::DB::Object::Manager::Debug = 1; foreach my $select (@selects) { $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyOracleObject', select => $select, require_objects => [ 'nicks' ], query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->nicks->[0]->nick && !defined $o->nicks->[0]->type_id && !defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->nicks->[0]->nick && !defined $o->nicks->[0]->type_id && !defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; ok(!$iterator->next, "custom select $i - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', select => $select, require_objects => [ 'nicks' ], query => [ id => { gt => 2 } ], sort_by => 'id', limit => 2); $i++; ok($objs->[0]->id > 2 && defined $objs->[0]->name && defined $objs->[0]->nicks->[0]->nick && !defined $objs->[0]->nicks->[0]->type_id && !defined $objs->[0]->flag2 && $objs->[0]->derived eq 'DERIVED: ' . uc($objs->[0]->name), "custom select $i - $db_type"); $i++; ok($objs->[1]->id > 2 && defined $objs->[1]->name && defined $objs->[1]->nicks->[0]->nick && !defined $objs->[1]->nicks->[0]->type_id && !defined $objs->[1]->flag2 && $objs->[1]->derived eq 'DERIVED: ' . uc($objs->[1]->name), "custom select $i - $db_type"); $i++; is(scalar @$objs, 2, "custom select $i - $db_type"); } @selects = ( #'t2.nick, t1.*, t2.id, t1.name, UPPER(t1.name) AS derived', [ qw(t2.nick t2.id t1.*), 'UPPER(t1.name) AS derived' ], ); #local $Rose::DB::Object::Manager::Debug = 1; foreach my $select (@selects) { $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyOracleObject', select => $select, require_objects => [ 'nicks' ], query => [ id => { gt => 2 } ], sort_by => 't1.id', limit => 2); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->nicks->[0]->nick && !defined $o->nicks->[0]->type_id && defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->nicks->[0]->nick && !defined $o->nicks->[0]->type_id && defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; ok(!$iterator->next, "custom select $i - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', select => $select, require_objects => [ 'nicks' ], query => [ id => { gt => 2 } ], sort_by => 't1.id', limit => 2); $i++; ok($objs->[0]->id > 2 && defined $objs->[0]->name && defined $objs->[0]->nicks->[0]->nick && !defined $objs->[0]->nicks->[0]->type_id && defined $objs->[0]->flag2 && $objs->[0]->derived eq 'DERIVED: ' . uc($objs->[0]->name), "custom select $i - $db_type"); $i++; ok($objs->[1]->id > 2 && defined $objs->[1]->name && defined $objs->[1]->nicks->[0]->nick && !defined $objs->[1]->nicks->[0]->type_id && defined $objs->[1]->flag2 && $objs->[1]->derived eq 'DERIVED: ' . uc($objs->[1]->name), "custom select $i - $db_type"); $i++; is(scalar @$objs, 2, "custom select $i - $db_type"); } @selects = ( '*, UPPER(t1.name) AS derived', [ '*', 'UPPER(t1.name) AS derived' ], ); #local $Rose::DB::Object::Manager::Debug = 1; foreach my $select (@selects) { $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MyOracleObject', select => $select, query => [ id => { gt => 2 } ], sort_by => 't1.id', limit => 2); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; $o = $iterator->next; ok($o->id > 2 && defined $o->name && defined $o->flag2 && $o->derived eq 'DERIVED: ' . uc($o->name), "custom select $i - $db_type"); $i++; ok(!$iterator->next, "custom select $i - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MyOracleObject', select => $select, query => [ id => { gt => 2 } ], sort_by => 't1.id', limit => 2); $i++; ok($objs->[0]->id > 2 && defined $objs->[0]->name && defined $objs->[0]->flag2 && $objs->[0]->derived eq 'DERIVED: ' . uc($objs->[0]->name), "custom select $i - $db_type"); $i++; ok($objs->[1]->id > 2 && defined $objs->[1]->name && defined $objs->[1]->flag2 && $objs->[1]->derived eq 'DERIVED: ' . uc($objs->[1]->name), "custom select $i - $db_type"); $i++; is(scalar @$objs, 2, "custom select $i - $db_type"); } } # End custom select tests } BEGIN { # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_PG = 1; Rose::DB->default_type('pg'); # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_color_map CASCADE'); $dbh->do('DROP TABLE rose_db_object_colors CASCADE'); $dbh->do('DROP TABLE rose_db_object_nicks CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_types2 CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_types CASCADE'); $dbh->do('DROP TABLE rose_db_object_nicks2 CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_alts CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_opts CASCADE'); $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->do('DROP TABLE rose_db_object_other CASCADE'); $dbh->do('DROP TABLE rose_db_object_bb CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32), UNIQUE(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_bb ( id INT NOT NULL PRIMARY KEY, name VARCHAR(32) ) EOF # Create test foreign subclasses package MyPgOtherObject; our @ISA = qw(Rose::DB::Object); MyPgOtherObject->meta->table('rose_db_object_other'); MyPgOtherObject->meta->columns ( name => { type => 'varchar'}, k1 => { type => 'int' }, k2 => { type => 'int' }, k3 => { type => 'int' }, ); MyPgOtherObject->meta->primary_key_columns(qw(k1 k2 k3)); MyPgOtherObject->meta->initialize; package MyPgBB; our @ISA = qw(Rose::DB::Object); MyPgBB->meta->table('rose_db_object_bb'); MyPgBB->meta->columns ( id => { type => 'int', primary_key => 1 }, name => { type => 'varchar'}, ); MyPgBB->meta->initialize; $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits BIT(5) NOT NULL DEFAULT B'00101', fixed CHAR(16) DEFAULT 'needed', start DATE, save INT, nums INT[], fk1 INT, fk2 INT, fk3 INT, b1 INT REFERENCES rose_db_object_bb (id), b2 INT REFERENCES rose_db_object_bb (id), data BYTEA, last_modified TIMESTAMP, date_created TIMESTAMP, FOREIGN KEY (fk1, fk2, fk3) REFERENCES rose_db_object_other (k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nick_types2 ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL UNIQUE ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nick_types ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL UNIQUE, t2_id INT REFERENCES rose_db_object_nick_types2 (id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nicks ( id SERIAL NOT NULL PRIMARY KEY, o_id INT NOT NULL REFERENCES rose_db_object_test (id), nick VARCHAR(32), type_id INT REFERENCES rose_db_object_nick_types (id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nick_alts ( id SERIAL NOT NULL PRIMARY KEY, nick_id INT NOT NULL REFERENCES rose_db_object_nicks (id), alt VARCHAR(32) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nick_opts ( id SERIAL NOT NULL PRIMARY KEY, nick_id INT NOT NULL REFERENCES rose_db_object_nicks (id), opt VARCHAR(32) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nicks2 ( id SERIAL NOT NULL PRIMARY KEY, o_id INT NOT NULL REFERENCES rose_db_object_test (id), nick2 VARCHAR(32) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_color_map ( id SERIAL NOT NULL PRIMARY KEY, object_id INT NOT NULL REFERENCES rose_db_object_test (id), color_id INT NOT NULL REFERENCES rose_db_object_colors (id) ) EOF $dbh->disconnect; package MyPgNickType2; our @ISA = qw(Rose::DB::Object); MyPgNickType2->meta->table('rose_db_object_nick_types2'); MyPgNickType2->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', length => 32 }, ); MyPgNickType2->meta->add_unique_key('name'); MyPgNickType2->meta->initialize; package MyPgNickType; our @ISA = qw(Rose::DB::Object); MyPgNickType->meta->table('rose_db_object_nick_types'); MyPgNickType->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', length => 32 }, t2_id => { type => 'int' }, ); MyPgNickType->meta->add_unique_key('name'); MyPgNickType->meta->foreign_keys ( t2 => { class => 'MyPgNickType2', key_columns => { t2_id => 'id' }, } ); MyPgNickType->meta->initialize; package MyPgNick; our @ISA = qw(Rose::DB::Object); MyPgNick->meta->table('rose_db_object_nicks'); MyPgNick->meta->columns ( id => { type => 'serial', primary_key => 1 }, o_id => { type => 'int' }, nick => { type => 'varchar', lazy => 1 }, type_id => { type => 'int' }, ); MyPgNick->meta->foreign_keys ( obj => { class => 'MyPgObject', key_columns => { o_id => 'id' }, }, type => { class => 'MyPgNickType', key_columns => { type_id => 'id' }, }, ); MyPgNick->meta->relationships ( alts => { type => 'one to many', class => 'MyPgNickAlt', key_columns => { id => 'nick_id' }, }, opts => { type => 'one to many', class => 'MyPgNickOpt', key_columns => { id => 'nick_id' }, }, ); MyPgNick->meta->initialize; package MyPgNick2; our @ISA = qw(Rose::DB::Object); MyPgNick2->meta->table('rose_db_object_nicks2'); MyPgNick2->meta->columns ( id => { type => 'serial', primary_key => 1 }, o_id => { type => 'int' }, nick2 => { type => 'varchar'}, ); MyPgNick2->meta->foreign_keys ( obj => { class => 'MyPgObject', key_columns => { o_id => 'id' }, }, ); MyPgNick2->meta->initialize; package MyPgNickAlt; our @ISA = qw(Rose::DB::Object); MyPgNickAlt->meta->table('rose_db_object_nick_alts'); MyPgNickAlt->meta->columns ( id => { type => 'serial', primary_key => 1 }, nick_id => { type => 'int' }, alt => { type => 'varchar' }, ); MyPgNickAlt->meta->foreign_keys ( type => { class => 'MyPgNick', key_columns => { nick_id => 'id' }, }, ); MyPgNickAlt->meta->initialize; package MyPgNickOpt; our @ISA = qw(Rose::DB::Object); MyPgNickOpt->meta->table('rose_db_object_nick_opts'); MyPgNickOpt->meta->columns ( id => { type => 'serial', primary_key => 1 }, nick_id => { type => 'int' }, opt => { type => 'varchar' }, ); MyPgNickOpt->meta->foreign_keys ( type => { class => 'MyPgNick', key_columns => { nick_id => 'id' }, }, ); MyPgNickOpt->meta->initialize; package MyPgColor; our @ISA = qw(Rose::DB::Object); MyPgColor->meta->table('rose_db_object_colors'); MyPgColor->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', not_null => 1 }, ); MyPgColor->meta->relationships ( objects => { type => 'many to many', map_class => 'MyPgColorMap', }, ); MyPgColor->meta->initialize; package MyPgColorMap; our @ISA = qw(Rose::DB::Object); MyPgColorMap->meta->table('rose_db_object_color_map'); MyPgColorMap->meta->columns ( id => { type => 'serial', primary_key => 1 }, object_id => { type => 'int', not_null => 1 }, color_id => { type => 'int', not_null => 1 }, ); MyPgColorMap->meta->foreign_keys ( color => { class => 'MyPgColor', key_columns => { color_id => 'id' }, }, object => { class => 'MyPgObject', key_columns => { object_id => 'id' }, }, ); MyPgColorMap->meta->initialize; # Create test subclass package MyPgObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub extra { $_[0]->{'extra'} = $_[1] if(@_ > 1); $_[0]->{'extra'} } MyPgObject->meta->table('rose_db_object_test'); MyPgObject->meta->columns ( 'name', id => { primary_key => 1 }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active', lazy => 1 }, start => { type => 'date', default => '12/24/1980', lazy => 1 }, save => { type => 'scalar' }, nums => { type => 'array' }, bits => { type => 'bitfield', bits => 5, default => 101 }, fixed => { type => 'char', length => 16, default => 'needed' },, fk1 => { type => 'int' }, fk2 => { type => 'int' }, fk3 => { type => 'int' }, b1 => { type => 'int' }, b2 => { type => 'int' }, data => { type => 'bytea' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); sub derived { return 'DERIVED: ' . $_[0]->{'derived'} if(@_ == 1); return $_[0]->{'derived'} = $_[1] } MyPgObject->meta->foreign_keys ( other_obj => { class => 'MyPgOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', } }, bb1 => { class => 'MyPgBB', key_columns => { b1 => 'id' }, }, bb2 => { class => 'MyPgBB', key_columns => { b2 => 'id' }, }, ); MyPgObject->meta->relationships ( nicks => { type => 'one to many', class => 'MyPgNick', column_map => { id => 'o_id' }, manager_args => { sort_by => 'nick DESC' }, }, nicks2 => { type => 'one to many', class => 'MyPgNick2', column_map => { id => 'o_id' }, manager_args => { sort_by => 'nick2 DESC' }, }, colors => { type => 'many to many', map_class => 'MyPgColorMap', manager_args => { sort_by => MyPgColor->meta->table . '.name DESC' }, }, ); MyPgObject->meta->alias_column(fk1 => 'fkone'); eval { MyPgObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method - pg'); MyPgObject->meta->alias_column(save => 'save_col'); MyPgObject->meta->initialize(preserve_existing => 1); Rose::DB::Object::Manager->make_manager_methods(base_name => 'objectz'); eval { Rose::DB::Object::Manager->make_manager_methods('objectz') }; Test::More::ok($@, 'make_manager_methods clash - pg'); Test::More::is(MyPgObject->meta->perl_manager_class(class => 'MyPgObjectMgr'), <<"EOF", 'perl_manager_class - pg'); package MyPgObjectMgr; use strict; use Rose::DB::Object::Manager; our \@ISA = qw(Rose::DB::Object::Manager); sub object_class { 'MyPgObject' } __PACKAGE__->make_manager_methods('my_pg_objects'); 1; EOF eval { MyPgObject->meta->perl_manager_class(class => 'MyPgObjectMgr') }; Test::More::ok(!$@, 'make_manager_class - pg'); package MyPgObjectManager; our @ISA = qw(Rose::DB::Object::Manager); sub object_class { 'MyPgObject' } MyPgObjectManager->make_manager_methods(object_class => 'MyPgObject', methods => { objectz => [ qw(objects iterator) ], 'object_count()' => 'count' }); } # # MySQL # my $db_version; eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh() or die Rose::DB->error; $db_version = $db->database_version; }; if(!$@ && $dbh) { our $HAVE_MYSQL = 1; Rose::DB->default_type('mysql'); # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_color_map CASCADE'); $dbh->do('DROP TABLE rose_db_object_colors CASCADE'); $dbh->do('DROP TABLE rose_db_object_nicks CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_types2 CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_types CASCADE'); $dbh->do('DROP TABLE rose_db_object_nicks2 CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_alts CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_opts CASCADE'); $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->do('DROP TABLE rose_db_object_other CASCADE'); $dbh->do('DROP TABLE rose_db_object_bb CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32), KEY(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE INDEX rose_db_object_other_idx ON rose_db_object_other (name) EOF $dbh->do(<<"EOF"); CREATE INDEX rose_db_object_other_idx2 ON rose_db_object_other (k1) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_bb ( id INT NOT NULL PRIMARY KEY, name VARCHAR(32) ) EOF # Create test foreign subclasses package MyMySQLOtherObject; our @ISA = qw(Rose::DB::Object); MyMySQLOtherObject->meta->table('rose_db_object_other'); MyMySQLOtherObject->meta->columns ( name => { type => 'varchar'}, k1 => { type => 'int' }, k2 => { type => 'int' }, k3 => { type => 'int' }, ); MyMySQLOtherObject->meta->primary_key_columns([ qw(k1 k2 k3) ]); MyMySQLOtherObject->meta->initialize; package MyMySQLBB; our @ISA = qw(Rose::DB::Object); MyMySQLBB->meta->table('rose_db_object_bb'); MyMySQLBB->meta->columns ( id => { type => 'int', primary_key => 1 }, name => { type => 'varchar'}, ); MyMySQLBB->meta->initialize; # MySQL 5.0.3 or later has a completely stupid "native" BIT type my $bit_col = ($db_version >= 5_000_003) ? q(bits BIT(5) NOT NULL DEFAULT B'00101') : q(bits BIT(5) NOT NULL DEFAULT '00101'); my $set_col = ($db_version >= 5_000_000) ? q(items SET('a','b','c') NOT NULL DEFAULT 'a,c') : q(items VARCHAR(255) NOT NULL DEFAULT 'a,c'); $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, name VARCHAR(32) NOT NULL, flag TINYINT(1) NOT NULL, flag2 TINYINT(1), status VARCHAR(32) DEFAULT 'active', $bit_col, $set_col, fixed CHAR(16) DEFAULT 'needed', nums VARCHAR(255), start DATE, save INT, fk1 INT, fk2 INT, fk3 INT, b1 INT, b2 INT, last_modified TIMESTAMP, date_created DATETIME ) EOF $dbh->do(<<"EOF"); CREATE INDEX rose_db_object_test_idx ON rose_db_object_test (name) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nick_types2 ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, name VARCHAR(32) NOT NULL UNIQUE ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nick_types ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, name VARCHAR(32) NOT NULL UNIQUE, t2_id INT REFERENCES rose_db_object_nick_types2 (id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nicks ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, o_id INT UNSIGNED NOT NULL REFERENCES rose_db_object_test (id), nick VARCHAR(32), type_id INT REFERENCES rose_db_object_nick_types (id) ) EOF $dbh->do(<<"EOF"); CREATE INDEX rose_db_object_nicks_idx ON rose_db_object_nicks (nick) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nick_alts ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, nick_id INT NOT NULL REFERENCES rose_db_object_nicks (id), alt VARCHAR(32) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nick_opts ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, nick_id INT NOT NULL REFERENCES rose_db_object_nicks (id), opt VARCHAR(32) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nicks2 ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, o_id INT UNSIGNED NOT NULL REFERENCES rose_db_object_test (id), nick2 VARCHAR(32) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_colors ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, name VARCHAR(32) NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_color_map ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, object_id INT UNSIGNED NOT NULL REFERENCES rose_db_object_test (id), color_id INT UNSIGNED NOT NULL REFERENCES rose_db_object_colors (id) ) EOF $dbh->disconnect; package MyMySQLNickType2; our @ISA = qw(Rose::DB::Object); MyMySQLNickType2->meta->table('rose_db_object_nick_types2'); MyMySQLNickType2->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', length => 32 }, ); MyMySQLNickType2->meta->add_unique_key('name'); MyMySQLNickType2->meta->initialize; package MyMySQLNickType; our @ISA = qw(Rose::DB::Object); MyMySQLNickType->meta->table('rose_db_object_nick_types'); MyMySQLNickType->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', length => 32 }, t2_id => { type => 'int' }, ); MyMySQLNickType->meta->add_unique_key('name'); MyMySQLNickType->meta->foreign_keys ( t2 => { class => 'MyMySQLNickType2', key_columns => { t2_id => 'id' }, } ); MyMySQLNickType->meta->initialize; package MyMySQLNick; our @ISA = qw(Rose::DB::Object); MyMySQLNick->meta->table('rose_db_object_nicks'); MyMySQLNick->meta->columns ( id => { type => 'int', primary_key => 1 }, o_id => { type => 'int' }, nick => { type => 'varchar', lazy => 1 }, type_id => { type => 'int' }, ); MyMySQLNick->meta->relationships ( alts => { type => 'one to many', class => 'MyMySQLNickAlt', key_columns => { id => 'nick_id' }, }, opts => { type => 'one to many', class => 'MyMySQLNickOpt', key_columns => { id => 'nick_id' }, }, ); MyMySQLNick->meta->foreign_keys ( obj => { class => 'MyMySQLObject', key_columns => { o_id => 'id' }, }, type => { class => 'MyMySQLNickType', key_columns => { type_id => 'id' }, }, ); MyMySQLNick->meta->initialize; package MyMySQLNick2; our @ISA = qw(Rose::DB::Object); MyMySQLNick2->meta->table('rose_db_object_nicks2'); MyMySQLNick2->meta->columns ( id => { type => 'int', primary_key => 1 }, o_id => { type => 'int' }, nick2 => { type => 'varchar'}, ); MyMySQLNick2->meta->foreign_keys ( obj => { class => 'MyMySQLObject', key_columns => { o_id => 'id' }, }, ); MyMySQLNick2->meta->initialize; package MyMySQLNickAlt; our @ISA = qw(Rose::DB::Object); MyMySQLNickAlt->meta->table('rose_db_object_nick_alts'); MyMySQLNickAlt->meta->columns ( id => { type => 'serial', primary_key => 1 }, nick_id => { type => 'int' }, alt => { type => 'varchar' }, ); MyMySQLNickAlt->meta->foreign_keys ( type => { class => 'MyMySQLNick', key_columns => { nick_id => 'id' }, }, ); MyMySQLNickAlt->meta->initialize; package MyMySQLNickOpt; our @ISA = qw(Rose::DB::Object); MyMySQLNickOpt->meta->table('rose_db_object_nick_opts'); MyMySQLNickOpt->meta->columns ( id => { type => 'serial', primary_key => 1 }, nick_id => { type => 'int' }, opt => { type => 'varchar' }, ); MyMySQLNickOpt->meta->foreign_keys ( type => { class => 'MyMySQLNick', key_columns => { nick_id => 'id' }, }, ); MyMySQLNickOpt->meta->initialize; package MyMySQLColor; our @ISA = qw(Rose::DB::Object); MyMySQLColor->meta->table('rose_db_object_colors'); MyMySQLColor->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', not_null => 1 }, ); MyMySQLColor->meta->relationships ( objects => { type => 'many to many', map_class => 'MyMySQLColorMap', }, ); MyMySQLColor->meta->initialize; package MyMySQLColorMap; our @ISA = qw(Rose::DB::Object); MyMySQLColorMap->meta->table('rose_db_object_color_map'); MyMySQLColorMap->meta->columns ( id => { type => 'serial', primary_key => 1 }, object_id => { type => 'int', not_null => 1 }, color_id => { type => 'int', not_null => 1 }, ); MyMySQLColorMap->meta->foreign_keys ( color => { class => 'MyMySQLColor', key_columns => { color_id => 'id' }, }, object => { class => 'MyMySQLObject', key_columns => { object_id => 'id' }, }, ); MyMySQLColorMap->meta->initialize; # Create test subclass package MyMySQLObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub extra { $_[0]->{'extra'} = $_[1] if(@_ > 1); $_[0]->{'extra'} } MyMySQLObject->meta->allow_inline_column_values(1); MyMySQLObject->meta->table('rose_db_object_test'); MyMySQLObject->meta->columns ( 'name', id => { primary_key => 1 }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active', lazy => 1 }, start => { type => 'date', default => '12/24/1980', lazy => 1 }, save => { type => 'scalar' }, bits => { type => 'bitfield', bits => 5, default => 101 }, items => { type => 'set', check_in => [ qw(a b c) ], default => 'a,c' }, fixed => { type => 'char', length => 16, default => 'needed' }, nums => { type => 'array' }, fk1 => { type => 'int' }, fk2 => { type => 'int' }, fk3 => { type => 'int' }, b1 => { type => 'int' }, b2 => { type => 'int' }, last_modified => { type => 'timestamp' }, date_created => { type => 'datetime' }, ); sub derived { return 'DERIVED: ' . $_[0]->{'derived'} if(@_ == 1); return $_[0]->{'derived'} = $_[1] } MyMySQLObject->meta->foreign_keys ( other_obj => { class => 'MyMySQLOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, method_types => [ 'get_set_now' ], # should be a no-op }, bb1 => { class => 'MyMySQLBB', key_columns => { b1 => 'id' }, method_types => [ 'get_set_now' ], # should be a no-op }, bb2 => { class => 'MyMySQLBB', key_columns => { b2 => 'id' }, method_types => [ 'get_set_now' ], # should be a no-op }, ); MyMySQLObject->meta->relationships ( nicks => { type => 'one to many', class => 'MyMySQLNick', column_map => { id => 'o_id' }, join_args => [ 't1.name' => { ne => \'t2.nick' }, 'rose_db_object_test.name' => { ne => \'rose_db_object_nicks.nick' }, 'date_created' => { gt => DateTime->now->subtract(years => 100) }, ], manager_args => { sort_by => 'nick DESC' }, }, nicks2 => { type => 'one to many', class => 'MyMySQLNick2', column_map => { id => 'o_id' }, manager_args => { sort_by => 'nick2 DESC' }, }, colors => { type => 'many to many', map_class => 'MyMySQLColorMap', manager_args => { sort_by => MyMySQLColor->meta->table . '.name DESC' }, }, ); MyMySQLObject->meta->alias_column(fk1 => 'fkone'); eval { MyMySQLObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method - mysql'); MyMySQLObject->meta->alias_column(save => 'save_col'); MyMySQLObject->meta->initialize(preserve_existing => 1); Rose::DB::Object::Manager->make_manager_methods('objectz'); eval { Rose::DB::Object::Manager->make_manager_methods('objectz') }; Test::More::ok($@, 'make_manager_methods clash - mysql'); package MyMySQLObjectManager; our @ISA = qw(Rose::DB::Object::Manager); sub object_class { 'MyMySQLObject' } Rose::DB::Object::Manager->make_manager_methods('objectz'); eval { Rose::DB::Object::Manager->make_manager_methods(object_class => 'MyMySQLObject', base_name => 'objectz', methods => {}) }; Test::More::ok($@ =~ /not both/, 'make_manager_methods params clash - mysql'); } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_INFORMIX = 1; Rose::DB->default_type('informix'); # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_color_map CASCADE'); $dbh->do('DROP TABLE rose_db_object_colors CASCADE'); $dbh->do('DROP TABLE rose_db_object_nicks CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_types2 CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_types CASCADE'); $dbh->do('DROP TABLE rose_db_object_nicks2 CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_alts CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_opts CASCADE'); $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->do('DROP TABLE rose_db_object_other CASCADE'); $dbh->do('DROP TABLE rose_db_object_bb CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32), UNIQUE(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_bb ( id INT NOT NULL PRIMARY KEY, name VARCHAR(32) ) EOF # Create test foreign subclasses package MyInformixOtherObject; our @ISA = qw(Rose::DB::Object); MyInformixOtherObject->meta->table('rose_db_object_other'); MyInformixOtherObject->meta->columns ( name => { type => 'varchar'}, k1 => { type => 'int' }, k2 => { type => 'int' }, k3 => { type => 'int' }, ); MyInformixOtherObject->meta->primary_key_columns(qw(k1 k2 k3)); MyInformixOtherObject->meta->initialize; package MyInformixBB; our @ISA = qw(Rose::DB::Object); MyInformixBB->meta->table('rose_db_object_bb'); MyInformixBB->meta->columns ( id => { type => 'int', primary_key => 1 }, name => { type => 'varchar'}, ); MyInformixBB->meta->initialize; $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits VARCHAR(5) DEFAULT '00101' NOT NULL, fixed CHAR(16) DEFAULT 'needed', start DATE, save INT, nums SET(INT NOT NULL), fk1 INT, fk2 INT, fk3 INT, b1 INT REFERENCES rose_db_object_bb (id), b2 INT REFERENCES rose_db_object_bb (id), last_modified DATETIME YEAR TO FRACTION(5), date_created DATETIME YEAR TO FRACTION(5), FOREIGN KEY (fk1, fk2, fk3) REFERENCES rose_db_object_other (k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nick_types2 ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL UNIQUE ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nick_types ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL UNIQUE, t2_id INT REFERENCES rose_db_object_nick_types2 (id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nicks ( id SERIAL NOT NULL PRIMARY KEY, o_id INT NOT NULL REFERENCES rose_db_object_test (id), nick VARCHAR(32), type_id INT REFERENCES rose_db_object_nick_types (id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nick_alts ( id SERIAL NOT NULL PRIMARY KEY, nick_id INT NOT NULL REFERENCES rose_db_object_nicks (id), alt VARCHAR(32) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nick_opts ( id SERIAL NOT NULL PRIMARY KEY, nick_id INT NOT NULL REFERENCES rose_db_object_nicks (id), opt VARCHAR(32) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nicks2 ( id SERIAL NOT NULL PRIMARY KEY, o_id INT NOT NULL REFERENCES rose_db_object_test (id), nick2 VARCHAR(32) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_color_map ( id SERIAL NOT NULL PRIMARY KEY, object_id INT NOT NULL REFERENCES rose_db_object_test (id), color_id INT NOT NULL REFERENCES rose_db_object_colors (id) ) EOF $dbh->disconnect; package MyInformixNickType2; our @ISA = qw(Rose::DB::Object); MyInformixNickType2->meta->table('rose_db_object_nick_types2'); MyInformixNickType2->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', length => 32 }, ); MyInformixNickType2->meta->add_unique_key('name'); MyInformixNickType2->meta->initialize; package MyInformixNickType; our @ISA = qw(Rose::DB::Object); MyInformixNickType->meta->table('rose_db_object_nick_types'); MyInformixNickType->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', length => 32 }, t2_id => { type => 'int' }, ); MyInformixNickType->meta->add_unique_key('name'); MyInformixNickType->meta->foreign_keys ( t2 => { class => 'MyInformixNickType2', key_columns => { t2_id => 'id' }, } ); MyInformixNickType->meta->initialize; package MyInformixNick; our @ISA = qw(Rose::DB::Object); MyInformixNick->meta->table('rose_db_object_nicks'); MyInformixNick->meta->columns ( id => { type => 'serial', primary_key => 1 }, o_id => { type => 'int' }, nick => { type => 'varchar', lazy => 1 }, type_id => { type => 'int' }, ); MyInformixNick->meta->foreign_keys ( obj => { class => 'MyInformixObject', key_columns => { o_id => 'id' }, }, type => { class => 'MyInformixNickType', key_columns => { type_id => 'id' }, }, ); MyInformixNick->meta->relationships ( alts => { type => 'one to many', class => 'MyInformixNickAlt', key_columns => { id => 'nick_id' }, }, opts => { type => 'one to many', class => 'MyInformixNickOpt', key_columns => { id => 'nick_id' }, }, ); MyInformixNick->meta->initialize; package MyInformixNick2; our @ISA = qw(Rose::DB::Object); MyInformixNick2->meta->table('rose_db_object_nicks2'); MyInformixNick2->meta->columns ( id => { type => 'serial', primary_key => 1 }, o_id => { type => 'int' }, nick2 => { type => 'varchar'}, ); MyInformixNick2->meta->foreign_keys ( obj => { class => 'MyInformixObject', key_columns => { o_id => 'id' }, }, ); MyInformixNick2->meta->initialize; package MyInformixNickAlt; our @ISA = qw(Rose::DB::Object); MyInformixNickAlt->meta->table('rose_db_object_nick_alts'); MyInformixNickAlt->meta->columns ( id => { type => 'serial', primary_key => 1 }, nick_id => { type => 'int' }, alt => { type => 'varchar' }, ); MyInformixNickAlt->meta->foreign_keys ( type => { class => 'MyInformixNick', key_columns => { nick_id => 'id' }, }, ); MyInformixNickAlt->meta->initialize; package MyInformixNickOpt; our @ISA = qw(Rose::DB::Object); MyInformixNickOpt->meta->table('rose_db_object_nick_opts'); MyInformixNickOpt->meta->columns ( id => { type => 'serial', primary_key => 1 }, nick_id => { type => 'int' }, opt => { type => 'varchar' }, ); MyInformixNickOpt->meta->foreign_keys ( type => { class => 'MyInformixNick', key_columns => { nick_id => 'id' }, }, ); MyInformixNickOpt->meta->initialize; package MyInformixColor; our @ISA = qw(Rose::DB::Object); MyInformixColor->meta->table('rose_db_object_colors'); MyInformixColor->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', not_null => 1 }, ); MyInformixColor->meta->relationships ( objects => { type => 'many to many', map_class => 'MyInformixColorMap', }, ); MyInformixColor->meta->initialize; package MyInformixColorMap; our @ISA = qw(Rose::DB::Object); MyInformixColorMap->meta->table('rose_db_object_color_map'); MyInformixColorMap->meta->columns ( id => { type => 'serial', primary_key => 1 }, object_id => { type => 'int', not_null => 1 }, color_id => { type => 'int', not_null => 1 }, ); MyInformixColorMap->meta->foreign_keys ( color => { class => 'MyInformixColor', key_columns => { color_id => 'id' }, }, object => { class => 'MyInformixObject', key_columns => { object_id => 'id' }, }, ); MyInformixColorMap->meta->initialize; # Create test subclass package MyInformixObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub extra { $_[0]->{'extra'} = $_[1] if(@_ > 1); $_[0]->{'extra'} } MyInformixObject->meta->table('rose_db_object_test'); MyInformixObject->meta->columns ( 'name', id => { primary_key => 1 }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active', lazy => 1 }, start => { type => 'date', default => '12/24/1980', lazy => 1 }, save => { type => 'scalar' }, nums => { type => 'set' }, bits => { type => 'bitfield', bits => 5, default => 101 }, fixed => { type => 'char', length => 16, default => 'needed' },, fk1 => { type => 'int' }, fk2 => { type => 'int' }, fk3 => { type => 'int' }, b1 => { type => 'int' }, b2 => { type => 'int' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); sub derived { return 'DERIVED: ' . $_[0]->{'derived'} if(@_ == 1); return $_[0]->{'derived'} = $_[1] } MyInformixObject->meta->foreign_keys ( other_obj => { class => 'MyInformixOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', } }, bb1 => { class => 'MyInformixBB', key_columns => { b1 => 'id' }, }, bb2 => { class => 'MyInformixBB', key_columns => { b2 => 'id' }, }, ); MyInformixObject->meta->relationships ( nicks => { type => 'one to many', class => 'MyInformixNick', column_map => { id => 'o_id' }, manager_args => { sort_by => 'nick DESC' }, }, nicks2 => { type => 'one to many', class => 'MyInformixNick2', column_map => { id => 'o_id' }, manager_args => { sort_by => 'nick2 DESC' }, }, colors => { type => 'many to many', map_class => 'MyInformixColorMap', manager_args => { sort_by => MyInformixColor->meta->table . '.name DESC' }, }, ); MyInformixObject->meta->alias_column(fk1 => 'fkone'); eval { MyInformixObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method - informix'); MyInformixObject->meta->alias_column(save => 'save_col'); MyInformixObject->meta->initialize(preserve_existing => 1); Rose::DB::Object::Manager->make_manager_methods('objectz'); eval { Rose::DB::Object::Manager->make_manager_methods('objectz') }; Test::More::ok($@, 'make_manager_methods clash - informix'); package MyInformixObjectManager; our @ISA = qw(Rose::DB::Object::Manager); sub object_class { 'MyInformixObject' } Rose::DB::Object::Manager->make_manager_methods(object_class => 'MyInformixObject', base_name => 'objectz'); MyInformixObject->meta->clear_all_dbs; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_SQLITE = 1; Rose::DB->default_type('sqlite'); # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_color_map'); $dbh->do('DROP TABLE rose_db_object_colors'); $dbh->do('DROP TABLE rose_db_object_nicks'); $dbh->do('DROP TABLE rose_db_object_nick_types2'); $dbh->do('DROP TABLE rose_db_object_nick_types'); $dbh->do('DROP TABLE rose_db_object_nicks2'); $dbh->do('DROP TABLE rose_db_object_nick_alts'); $dbh->do('DROP TABLE rose_db_object_nick_opts'); $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->do('DROP TABLE rose_db_object_bb'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32), UNIQUE(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_bb ( id INT NOT NULL PRIMARY KEY, name VARCHAR(32), z varchar(32) ) EOF # Create test foreign subclasses package MySQLiteOtherObject; our @ISA = qw(Rose::DB::Object); MySQLiteOtherObject->meta->table('rose_db_object_other'); MySQLiteOtherObject->meta->columns ( name => { type => 'varchar'}, k1 => { type => 'int' }, k2 => { type => 'int', alias => 'ktwo' }, k3 => { type => 'int' }, ); sub k2 { shift->ktwo(@_) } MySQLiteOtherObject->meta->primary_key_columns([ qw(k1 k2 k3) ]); MySQLiteOtherObject->meta->initialize; package MySQLiteBB; our @ISA = qw(Rose::DB::Object); MySQLiteBB->meta->table('rose_db_object_bb'); MySQLiteBB->meta->columns ( id => { type => 'int', primary_key => 1 }, name => { type => 'varchar' }, z => { type => 'varchar', alias => 'x' }, ); MySQLiteBB->meta->initialize; $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT NOT NULL PRIMARY KEY, f VARCHAR(10), name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits VARCHAR(5) DEFAULT '00101' NOT NULL, fixed CHAR(16) DEFAULT 'needed', start DATE, save INT, nums VACHAR(255), fk1 INT, fk2 INT, fk3 INT, b1 INT REFERENCES rose_db_object_bb (id), b2 INT REFERENCES rose_db_object_bb (id), last_modified TIMESTAMP, date_created TIMESTAMP, FOREIGN KEY (fk1, fk2, fk3) REFERENCES rose_db_object_other (k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nick_types2 ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(32) NOT NULL UNIQUE ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nick_types ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(32) NOT NULL UNIQUE, t2_id INT REFERENCES rose_db_object_nick_types2 (id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nicks ( id INTEGER PRIMARY KEY AUTOINCREMENT, o_id INT NOT NULL REFERENCES rose_db_object_test (id), nick VARCHAR(32), type_id INT REFERENCES rose_db_object_nick_types (id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nick_alts ( id INTEGER PRIMARY KEY AUTOINCREMENT, nick_id INT NOT NULL REFERENCES rose_db_object_nicks (id), alt VARCHAR(32) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nick_opts ( id INTEGER PRIMARY KEY AUTOINCREMENT, nick_id INT NOT NULL REFERENCES rose_db_object_nicks (id), opt VARCHAR(32) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nicks2 ( id INTEGER PRIMARY KEY AUTOINCREMENT, o_id INT NOT NULL REFERENCES rose_db_object_test (id), nick2 VARCHAR(32) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_colors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(32) NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_color_map ( id INTEGER PRIMARY KEY AUTOINCREMENT, object_id INT NOT NULL REFERENCES rose_db_object_test (id), color_id INT NOT NULL REFERENCES rose_db_object_colors (id) ) EOF $dbh->disconnect; package MySQLiteNickType2; our @ISA = qw(Rose::DB::Object); MySQLiteNickType2->meta->table('rose_db_object_nick_types2'); MySQLiteNickType2->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', length => 32 }, ); MySQLiteNickType2->meta->add_unique_key('name'); MySQLiteNickType2->meta->initialize; package MySQLiteNickType; our @ISA = qw(Rose::DB::Object); MySQLiteNickType->meta->table('rose_db_object_nick_types'); MySQLiteNickType->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', length => 32 }, t2_id => { type => 'int' }, ); MySQLiteNickType->meta->add_unique_key('name'); MySQLiteNickType->meta->foreign_keys ( t2 => { class => 'MySQLiteNickType2', key_columns => { t2_id => 'id' }, } ); MySQLiteNickType->meta->initialize; package MySQLiteNick; our @ISA = qw(Rose::DB::Object); MySQLiteNick->meta->table('rose_db_object_nicks'); MySQLiteNick->meta->columns ( id => { type => 'serial', alias => 'eyedee', primary_key => 1 }, o_id => { type => 'int' }, nick => { type => 'varchar', lazy => 1 }, type_id => { type => 'int' }, ); MySQLiteNick->meta->relationships ( alts => { type => 'one to many', class => 'MySQLiteNickAlt', key_columns => { id => 'nick_id' }, }, opts => { type => 'one to many', class => 'MySQLiteNickOpt', key_columns => { id => 'nick_id' }, }, ); MySQLiteNick->meta->foreign_keys ( obj => { class => 'MySQLiteObject', key_columns => { o_id => 'id' }, }, type => { class => 'MySQLiteNickType', key_columns => { type_id => 'id' }, }, ); MySQLiteNick->meta->initialize; package MySQLiteNick2; our @ISA = qw(Rose::DB::Object); MySQLiteNick2->meta->table('rose_db_object_nicks2'); MySQLiteNick2->meta->columns ( id => { type => 'serial', primary_key => 1 }, o_id => { type => 'int' }, nick2 => { type => 'varchar'}, ); MySQLiteNick2->meta->foreign_keys ( obj => { class => 'MySQLiteObject', key_columns => { o_id => 'id' }, }, ); MySQLiteNick2->meta->initialize; package MySQLiteNickAlt; our @ISA = qw(Rose::DB::Object); MySQLiteNickAlt->meta->table('rose_db_object_nick_alts'); MySQLiteNickAlt->meta->columns ( id => { type => 'serial', primary_key => 1 }, nick_id => { type => 'int' }, alt => { type => 'varchar' }, ); MySQLiteNickAlt->meta->foreign_keys ( type => { class => 'MySQLiteNick', key_columns => { nick_id => 'id' }, }, ); MySQLiteNickAlt->meta->initialize; package MySQLiteNickOpt; our @ISA = qw(Rose::DB::Object); MySQLiteNickOpt->meta->table('rose_db_object_nick_opts'); MySQLiteNickOpt->meta->columns ( id => { type => 'serial', primary_key => 1 }, nick_id => { type => 'int' }, opt => { type => 'varchar' }, ); MySQLiteNickOpt->meta->foreign_keys ( type => { class => 'MySQLiteNick', key_columns => { nick_id => 'id' }, }, ); MySQLiteNickOpt->meta->initialize; package MySQLiteColor; our @ISA = qw(Rose::DB::Object); MySQLiteColor->meta->table('rose_db_object_colors'); MySQLiteColor->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', not_null => 1 }, ); MySQLiteColor->meta->relationships ( objects => { type => 'many to many', map_class => 'MySQLiteColorMap', }, ); MySQLiteColor->meta->initialize; package MySQLiteColorMap; our @ISA = qw(Rose::DB::Object); MySQLiteColorMap->meta->table('rose_db_object_color_map'); MySQLiteColorMap->meta->columns ( id => { type => 'serial', primary_key => 1 }, object_id => { type => 'int', not_null => 1 }, color_id => { type => 'int', not_null => 1 }, ); MySQLiteColorMap->meta->foreign_keys ( color => { class => 'MySQLiteColor', key_columns => { color_id => 'id' }, }, object => { class => 'MySQLiteObject', key_columns => { object_id => 'id' }, }, ); MySQLiteColorMap->meta->initialize; # Create test subclass package MySQLiteObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub extra { $_[0]->{'extra'} = $_[1] if(@_ > 1); $_[0]->{'extra'} } MySQLiteObject->meta->table('rose_db_object_test'); MySQLiteObject->meta->columns ( 'name', 'f' => { type => 'varchar', length => 10, alias => 'foo' }, id => { primary_key => 1 }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active', lazy => 1 }, start => { type => 'date', default => '1980-12-24', lazy => 1 }, save => { type => 'scalar' }, nums => { type => 'array' }, bits => { type => 'bitfield', bits => 5, default => 101 }, fixed => { type => 'char', length => 16, default => 'needed' }, fk1 => { type => 'int' }, fk2 => { type => 'int' }, fk3 => { type => 'int' }, b1 => { type => 'int' }, b2 => { type => 'int' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); sub derived { return 'DERIVED: ' . $_[0]->{'derived'} if(@_ == 1); return $_[0]->{'derived'} = $_[1] } MySQLiteObject->meta->foreign_keys ( other_obj => { class => 'MySQLiteOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', } }, bb1 => { class => 'MySQLiteBB', key_columns => { b1 => 'id' }, }, bb2 => { class => 'MySQLiteBB', key_columns => { b2 => 'id' }, }, ); MySQLiteObject->meta->relationships ( nicks => { type => 'one to many', class => 'MySQLiteNick', column_map => { id => 'o_id' }, manager_args => { sort_by => 'nick DESC' }, }, nicks2 => { type => 'one to many', class => 'MySQLiteNick2', column_map => { id => 'o_id' }, manager_args => { sort_by => 'nick2 DESC' }, }, colors => { type => 'many to many', map_class => 'MySQLiteColorMap', manager_args => { sort_by => MySQLiteColor->meta->table . '.name DESC' }, }, ); MySQLiteObject->meta->alias_column(fk1 => 'fkone'); eval { MySQLiteObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method - sqlite'); MySQLiteObject->meta->alias_column(save => 'save_col'); MySQLiteObject->meta->initialize(preserve_existing => 1); Rose::DB::Object::Manager->make_manager_methods('objectz'); eval { Rose::DB::Object::Manager->make_manager_methods('objectz') }; Test::More::ok($@, 'make_manager_methods clash - sqlite'); package MySQLiteObjectManager; our @ISA = qw(Rose::DB::Object::Manager); sub object_class { 'MySQLiteObject' } Rose::DB::Object::Manager->make_manager_methods(object_class => 'MySQLiteObject', methods => { objectz => [ qw(objects iterator) ], 'object_count()' => 'count' }); } # # Oracle # eval { $dbh = Rose::DB->new('oracle_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_ORACLE = 1; Rose::DB->default_type('oracle'); # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_color_map CASCADE CONSTRAINTS'); $dbh->do('DROP TABLE rose_db_object_colors CASCADE CONSTRAINTS'); $dbh->do('DROP TABLE rose_db_object_nicks CASCADE CONSTRAINTS'); $dbh->do('DROP TABLE rose_db_object_nick_types2 CASCADE CONSTRAINTS'); $dbh->do('DROP TABLE rose_db_object_nick_types CASCADE CONSTRAINTS'); $dbh->do('DROP TABLE rose_db_object_nicks2 CASCADE CONSTRAINTS'); $dbh->do('DROP TABLE rose_db_object_nick_alts CASCADE CONSTRAINTS'); $dbh->do('DROP TABLE rose_db_object_nick_opts CASCADE CONSTRAINTS'); $dbh->do('DROP TABLE rose_db_object_test CASCADE CONSTRAINTS'); $dbh->do('DROP TABLE rose_db_object_other CASCADE CONSTRAINTS'); $dbh->do('DROP TABLE rose_db_object_bb CASCADE CONSTRAINTS'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32), PRIMARY KEY (k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_bb ( id INT NOT NULL PRIMARY KEY, name VARCHAR(32) ) EOF # Create test foreign subclasses package MyOracleOtherObject; our @ISA = qw(Rose::DB::Object); MyOracleOtherObject->meta->table('rose_db_object_other'); MyOracleOtherObject->meta->columns ( name => { type => 'varchar'}, k1 => { type => 'int' }, k2 => { type => 'int' }, k3 => { type => 'int' }, ); MyOracleOtherObject->meta->primary_key_columns(qw(k1 k2 k3)); MyOracleOtherObject->meta->initialize; package MyOracleBB; our @ISA = qw(Rose::DB::Object); MyOracleBB->meta->table('rose_db_object_bb'); MyOracleBB->meta->columns ( id => { type => 'int', primary_key => 1 }, name => { type => 'varchar'}, ); MyOracleBB->meta->initialize; $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, flag CHAR(1) NOT NULL CHECK(flag IN ('t', 'f')), flag2 CHAR(1) CHECK(flag2 IN ('t', 'f')), status VARCHAR(32) DEFAULT 'active', bits VARCHAR(5) DEFAULT '00101' NOT NULL, fixed CHAR(16) DEFAULT 'needed', start_date DATE, save INT, fk1 INT, fk2 INT, fk3 INT, b1 INT REFERENCES rose_db_object_bb (id), b2 INT REFERENCES rose_db_object_bb (id), last_modified TIMESTAMP, date_created TIMESTAMP, FOREIGN KEY (fk1, fk2, fk3) REFERENCES rose_db_object_other (k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nick_types2 ( id INT NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL UNIQUE ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nick_types ( id INT NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL UNIQUE, t2_id INT REFERENCES rose_db_object_nick_types2 (id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nicks ( id INT NOT NULL PRIMARY KEY, o_id INT NOT NULL REFERENCES rose_db_object_test (id), nick VARCHAR(32), type_id INT REFERENCES rose_db_object_nick_types (id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nick_alts ( id INT NOT NULL PRIMARY KEY, nick_id INT NOT NULL REFERENCES rose_db_object_nicks (id), alt VARCHAR(32) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nick_opts ( id INT NOT NULL PRIMARY KEY, nick_id INT NOT NULL REFERENCES rose_db_object_nicks (id), opt VARCHAR(32) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_nicks2 ( id INT NOT NULL PRIMARY KEY, o_id INT NOT NULL REFERENCES rose_db_object_test (id), nick2 VARCHAR(32) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_colors ( id INT NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_color_map ( id INT NOT NULL PRIMARY KEY, object_id INT NOT NULL REFERENCES rose_db_object_test (id), color_id INT NOT NULL REFERENCES rose_db_object_colors (id) ) EOF $dbh->disconnect; my $DB; package MyOracleNickType2; our @ISA = qw(Rose::DB::Object); sub init_db { $DB ||= Rose::DB->new } MyOracleNickType2->meta->table('rose_db_object_nick_types2'); MyOracleNickType2->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', length => 32 }, ); MyOracleNickType2->meta->add_unique_key('name'); MyOracleNickType2->meta->initialize; package MyOracleNickType; our @ISA = qw(Rose::DB::Object); sub init_db { $DB ||= Rose::DB->new } MyOracleNickType->meta->table('rose_db_object_nick_types'); MyOracleNickType->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', length => 32 }, t2_id => { type => 'int' }, ); MyOracleNickType->meta->add_unique_key('name'); MyOracleNickType->meta->foreign_keys ( t2 => { class => 'MyOracleNickType2', key_columns => { t2_id => 'id' }, } ); MyOracleNickType->meta->initialize; package MyOracleNick; our @ISA = qw(Rose::DB::Object); sub init_db { $DB ||= Rose::DB->new } MyOracleNick->meta->table('rose_db_object_nicks'); MyOracleNick->meta->columns ( id => { type => 'serial', primary_key => 1 }, o_id => { type => 'int' }, nick => { type => 'varchar', lazy => 1 }, type_id => { type => 'int' }, ); MyOracleNick->meta->foreign_keys ( obj => { class => 'MyOracleObject', key_columns => { o_id => 'id' }, }, type => { class => 'MyOracleNickType', key_columns => { type_id => 'id' }, }, ); MyOracleNick->meta->relationships ( alts => { type => 'one to many', class => 'MyOracleNickAlt', key_columns => { id => 'nick_id' }, }, opts => { type => 'one to many', class => 'MyOracleNickOpt', key_columns => { id => 'nick_id' }, }, ); MyOracleNick->meta->initialize; package MyOracleNick2; our @ISA = qw(Rose::DB::Object); sub init_db { $DB ||= Rose::DB->new } MyOracleNick2->meta->table('rose_db_object_nicks2'); MyOracleNick2->meta->columns ( id => { type => 'serial', primary_key => 1 }, o_id => { type => 'int' }, nick2 => { type => 'varchar'}, ); MyOracleNick2->meta->foreign_keys ( obj => { class => 'MyOracleObject', key_columns => { o_id => 'id' }, }, ); MyOracleNick2->meta->initialize; package MyOracleNickAlt; our @ISA = qw(Rose::DB::Object); sub init_db { $DB ||= Rose::DB->new } MyOracleNickAlt->meta->table('rose_db_object_nick_alts'); MyOracleNickAlt->meta->columns ( id => { type => 'serial', primary_key => 1 }, nick_id => { type => 'int' }, alt => { type => 'varchar' }, ); MyOracleNickAlt->meta->foreign_keys ( type => { class => 'MyOracleNick', key_columns => { nick_id => 'id' }, }, ); MyOracleNickAlt->meta->initialize; package MyOracleNickOpt; our @ISA = qw(Rose::DB::Object); sub init_db { $DB ||= Rose::DB->new } MyOracleNickOpt->meta->table('rose_db_object_nick_opts'); MyOracleNickOpt->meta->columns ( id => { type => 'serial', primary_key => 1 }, nick_id => { type => 'int' }, opt => { type => 'varchar' }, ); MyOracleNickOpt->meta->foreign_keys ( type => { class => 'MyOracleNick', key_columns => { nick_id => 'id' }, }, ); MyOracleNickOpt->meta->initialize; package MyOracleColor; our @ISA = qw(Rose::DB::Object); sub init_db { $DB ||= Rose::DB->new } MyOracleColor->meta->table('rose_db_object_colors'); MyOracleColor->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', not_null => 1 }, ); MyOracleColor->meta->relationships ( objects => { type => 'many to many', map_class => 'MyOracleColorMap', }, ); MyOracleColor->meta->initialize; package MyOracleColorMap; our @ISA = qw(Rose::DB::Object); sub init_db { $DB ||= Rose::DB->new } MyOracleColorMap->meta->table('rose_db_object_color_map'); MyOracleColorMap->meta->columns ( id => { type => 'serial', primary_key => 1 }, object_id => { type => 'int', not_null => 1 }, color_id => { type => 'int', not_null => 1 }, ); MyOracleColorMap->meta->foreign_keys ( color => { class => 'MyOracleColor', key_columns => { color_id => 'id' }, }, object => { class => 'MyOracleObject', key_columns => { object_id => 'id' }, }, ); MyOracleColorMap->meta->initialize; # Create test subclass package MyOracleObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub init_db { $DB ||= Rose::DB->new } sub extra { $_[0]->{'extra'} = $_[1] if(@_ > 1); $_[0]->{'extra'} } MyOracleObject->meta->table('rose_db_object_test'); MyOracleObject->meta->columns ( 'name', id => { primary_key => 1 }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active', lazy => 1 }, start_date => { type => 'date', default => '12/24/1980', lazy => 1 }, save => { type => 'scalar' }, bits => { type => 'bitfield', bits => 5, default => 101 }, fixed => { type => 'char', length => 16, default => 'needed' },, fk1 => { type => 'int' }, fk2 => { type => 'int' }, fk3 => { type => 'int' }, b1 => { type => 'int' }, b2 => { type => 'int' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); sub derived { return 'DERIVED: ' . $_[0]->{'derived'} if(@_ == 1); return $_[0]->{'derived'} = $_[1] } MyOracleObject->meta->foreign_keys ( other_obj => { class => 'MyOracleOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', } }, bb1 => { class => 'MyOracleBB', key_columns => { b1 => 'id' }, }, bb2 => { class => 'MyOracleBB', key_columns => { b2 => 'id' }, }, ); MyOracleObject->meta->relationships ( nicks => { type => 'one to many', class => 'MyOracleNick', column_map => { id => 'o_id' }, manager_args => { sort_by => 'nick DESC' }, }, nicks2 => { type => 'one to many', class => 'MyOracleNick2', column_map => { id => 'o_id' }, manager_args => { sort_by => 'nick2 DESC' }, }, colors => { type => 'many to many', map_class => 'MyOracleColorMap', manager_args => { sort_by => MyOracleColor->meta->table . '.name DESC' }, }, ); MyOracleObject->meta->alias_column(fk1 => 'fkone'); eval { MyOracleObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method - oracle'); MyOracleObject->meta->alias_column(save => 'save_col'); MyOracleObject->meta->initialize(preserve_existing => 1); Rose::DB::Object::Manager->make_manager_methods('objectz'); eval { Rose::DB::Object::Manager->make_manager_methods('objectz') }; Test::More::ok($@, 'make_manager_methods clash - oracle'); package MyOracleObjectManager; our @ISA = qw(Rose::DB::Object::Manager); sub object_class { 'MyOracleObject' } Rose::DB::Object::Manager->make_manager_methods(object_class => 'MyOracleObject', base_name => 'objectz'); MyOracleObject->meta->clear_all_dbs; } } END { # Delete test tables if($HAVE_PG) { my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_color_map CASCADE'); $dbh->do('DROP TABLE rose_db_object_colors CASCADE'); $dbh->do('DROP TABLE rose_db_object_nicks CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_types2 CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_types CASCADE'); $dbh->do('DROP TABLE rose_db_object_nicks2 CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_alts CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_opts CASCADE'); $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->do('DROP TABLE rose_db_object_other CASCADE'); $dbh->do('DROP TABLE rose_db_object_bb CASCADE'); $dbh->disconnect; } if($HAVE_MYSQL) { my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_color_map CASCADE'); $dbh->do('DROP TABLE rose_db_object_colors CASCADE'); $dbh->do('DROP TABLE rose_db_object_nicks CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_types2 CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_types CASCADE'); $dbh->do('DROP TABLE rose_db_object_nicks2 CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_alts CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_opts CASCADE'); $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->do('DROP TABLE rose_db_object_other CASCADE'); $dbh->do('DROP TABLE rose_db_object_bb CASCADE'); $dbh->disconnect; } if($HAVE_INFORMIX) { my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_color_map CASCADE'); $dbh->do('DROP TABLE rose_db_object_colors CASCADE'); $dbh->do('DROP TABLE rose_db_object_nicks CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_types2 CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_types CASCADE'); $dbh->do('DROP TABLE rose_db_object_nicks2 CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_alts CASCADE'); $dbh->do('DROP TABLE rose_db_object_nick_opts CASCADE'); $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->do('DROP TABLE rose_db_object_other CASCADE'); $dbh->do('DROP TABLE rose_db_object_bb CASCADE'); $dbh->disconnect; } if($HAVE_SQLITE) { my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_color_map'); $dbh->do('DROP TABLE rose_db_object_colors'); $dbh->do('DROP TABLE rose_db_object_nicks'); $dbh->do('DROP TABLE rose_db_object_nick_types2'); $dbh->do('DROP TABLE rose_db_object_nick_types'); $dbh->do('DROP TABLE rose_db_object_nicks2'); $dbh->do('DROP TABLE rose_db_object_nick_alts'); $dbh->do('DROP TABLE rose_db_object_nick_opts'); $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->do('DROP TABLE rose_db_object_bb'); $dbh->disconnect; } if($HAVE_ORACLE) { my $dbh = Rose::DB->new('oracle_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_color_map CASCADE CONSTRAINTS'); $dbh->do('DROP TABLE rose_db_object_colors CASCADE CONSTRAINTS'); $dbh->do('DROP TABLE rose_db_object_nicks CASCADE CONSTRAINTS'); $dbh->do('DROP TABLE rose_db_object_nick_types2 CASCADE CONSTRAINTS'); $dbh->do('DROP TABLE rose_db_object_nick_types CASCADE CONSTRAINTS'); $dbh->do('DROP TABLE rose_db_object_nicks2 CASCADE CONSTRAINTS'); $dbh->do('DROP TABLE rose_db_object_nick_alts CASCADE CONSTRAINTS'); $dbh->do('DROP TABLE rose_db_object_nick_opts CASCADE CONSTRAINTS'); $dbh->do('DROP TABLE rose_db_object_test CASCADE CONSTRAINTS'); $dbh->do('DROP TABLE rose_db_object_other CASCADE CONSTRAINTS'); $dbh->do('DROP TABLE rose_db_object_bb CASCADE CONSTRAINTS'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-mapper.t000755 000765 000120 00000115420 12054157213 017755 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 321; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); } our($PG_HAS_CHKPASS, $HAVE_PG, $HAVE_MYSQL, $HAVE_INFORMIX, $HAVE_SQLITE); # # PostgreSQL # SKIP: foreach my $db_type (qw(pg pg_with_schema)) { skip("PostgreSQL tests", 132) unless($HAVE_PG); Rose::DB->default_type($db_type); TEST_HACK: { no warnings; *MyPgObject::init_db = sub { Rose::DB->new($db_type) }; } my $o = MyPgObject->new(NAME => 'John', K1 => 1, K2 => undef, K3 => 3); #ok($o->can('id'), "no primary key alias - $db_type"); ok(ref $o && $o->isa('MyPgObject'), "new() 1 - $db_type"); $o->FLAG2('TRUE'); $o->DATE_CREATED('now'); $o->LAST_MODIFIED($o->DATE_CREATED); $o->SAVE_COL(7); ok($o->save, "save() 1 - $db_type"); is($o->ID, 1, "auto-generated primary key - $db_type"); ok($o->load, "load() 1 - $db_type"); $o->NAME('C' x 50); is($o->NAME, 'C' x 32, "varchar truncation - $db_type"); $o->NAME('John'); $o->CODE('A'); is($o->CODE, 'A ', "character padding - $db_type"); $o->CODE('C' x 50); is($o->CODE, 'C' x 6, "character truncation - $db_type"); my $os = Rose::DB::Object::Manager->get_objects( #debug => 1, object_class => ref($o), query => [ id => $o->ID, ]); is($os->[0]->ID, $o->ID, "Manager query with pk alias 1 - $db_type"); $os = Rose::DB::Object::Manager->get_objects( #debug => 1, object_class => ref($o), query => [ ID => $o->ID, ]); is($os->[0]->ID, $o->ID, "Manager query with pk alias 2 - $db_type"); my $ouk = MyPgObject->new(K1 => 1, K2 => undef, K3 => 3); ok($ouk->load, "load() uk 1 - $db_type"); ok(!$ouk->not_found, "not_found() uk 1 - $db_type"); is($ouk->ID, 1, "load() uk 2 - $db_type"); is($ouk->NAME, 'John', "load() uk 3 - $db_type"); ok($ouk->save, "save() uk 1 - $db_type"); my $o2 = MyPgObject->new(ID => $o->ID); ok(ref $o2 && $o2->isa('MyPgObject'), "new() 2 - $db_type"); is($o2->BITS->to_Bin, '00101', "BITS() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->NAME, $o->NAME, "load() verify 1 - $db_type"); is($o2->DATE_CREATED, $o->DATE_CREATED, "load() verify 2 - $db_type"); is($o2->LAST_MODIFIED, $o->LAST_MODIFIED, "load() verify 3 - $db_type"); is($o2->STATUS, 'active', "load() verify 4 (default value) - $db_type"); is($o2->FLAG, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->FLAG2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->SAVE_COL, 7, "load() verify 7 (aliased column) - $db_type"); is($o2->START->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->BITS->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); my $clone = $o2->clone; ok($o2->START eq $clone->START, "clone() 1 - $db_type"); $clone->START->set(year => '1960'); ok($o2->START ne $clone->START, "clone() 2 - $db_type"); $o2->NAME('John 2'); $o2->START('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->LAST_MODIFIED('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->DATE_CREATED, $o->DATE_CREATED, "save() verify 1 - $db_type"); ok($o2->LAST_MODIFIED ne $o->LAST_MODIFIED, "save() verify 2 - $db_type"); is($o2->START->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyPgObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyPgObject->new(ID => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->load, "load() 4 - $db_type"); SKIP: { if($PG_HAS_CHKPASS) { $o->{'PASSWORD_ENCRYPTED'} = ':8R1Kf2nOS0bRE'; ok($o->PASSWORD_IS('xyzzy'), "chkpass() 1 - $db_type"); is($o->PASSWORD, 'xyzzy', "chkpass() 2 - $db_type"); $o->PASSWORD('foobar'); ok($o->PASSWORD_IS('foobar'), "chkpass() 3 - $db_type"); is($o->PASSWORD, 'foobar', "chkpass() 4 - $db_type"); ok($o->save, "save() 3 - $db_type"); } else { skip("chkpass tests", 5); } } my $o5 = MyPgObject->new(ID => $o->ID); ok($o5->load, "load() 5 - $db_type"); SKIP: { if($PG_HAS_CHKPASS) { ok($o5->PASSWORD_IS('foobar'), "chkpass() 5 - $db_type"); is($o5->PASSWORD, 'foobar', "chkpass() 6 - $db_type"); } else { skip("chkpass tests", 2); } } $o5->NUMS([ 4, 5, 6 ]); ok($o5->save, "save() 4 - $db_type"); ok($o->load, "load() 6 - $db_type"); is($o5->NUMS->[0], 4, "load() verify 10 (array value) - $db_type"); is($o5->NUMS->[1], 5, "load() verify 11 (array value) - $db_type"); is($o5->NUMS->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o5->NUMS; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); ok($o->delete, "delete() - $db_type"); $o = MyPgObject->new(NAME => 'John', ID => 9); $o->SAVE_COL(22); ok($o->save, "save() 4 - $db_type"); $o->SAVE_COL(50); ok($o->save, "save() 5 - $db_type"); $ouk = MyPgObject->new(SAVE_COL => 50); ok($ouk->load, "load() aliased unique key - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, "alias_column() nonesuch - $db_type"); # This is okay now #eval { $o->meta->alias_column(ID => 'foo') }; #ok($@, "alias_column() primary key - $db_type"); $o = MyPgObject->new(ID => 777); $o->meta->error_mode('fatal'); $o->dbh->{'PrintError'} = 0; eval { $o->load }; ok($@ && $o->not_found, "load() not found fatal - $db_type"); $o->ID('abc'); eval { $o->load }; ok($@ && !$o->not_found, "load() fatal - $db_type"); eval { $o->save }; ok($@, "save() fatal - $db_type"); $o->meta->error_mode('return'); } # # MySQL # SKIP: foreach my $db_type ('mysql') { skip("MySQL tests", 64) unless($HAVE_MYSQL); Rose::DB->default_type($db_type); my $o = MyMySQLObject->new(NAME => 'John', K1 => 1, K2 => undef, K3 => 3); ok(ref $o && $o->isa('MyMySQLObject'), "new() 1 - $db_type"); #ok($o->can('id'), "no primary key alias - $db_type"); $o->FLAG2('true'); $o->DATE_CREATED('now'); $o->LAST_MODIFIED($o->DATE_CREATED); $o->SAVE_COL(22); $o->READ(55); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); $o->NAME('C' x 50); is($o->NAME, 'C' x 32, "varchar truncation - $db_type"); $o->NAME('John'); $o->CODE('A'); is($o->CODE, 'A ', "character padding - $db_type"); $o->CODE('C' x 50); is($o->CODE, 'C' x 6, "character truncation - $db_type"); my $os = Rose::DB::Object::Manager->get_objects( #debug => 1, object_class => ref($o), query => [ id => $o->ID, ]); is($os->[0]->ID, $o->ID, "Manager query with pk alias 1 - $db_type"); $os = Rose::DB::Object::Manager->get_objects( #debug => 1, object_class => ref($o), query => [ ID => $o->ID, ]); is($os->[0]->ID, $o->ID, "Manager query with pk alias 2 - $db_type"); my $ouk = MyMySQLObject->new(K1 => 1, K2 => undef, K3 => 3); ok($ouk->load, "load() uk 1 - $db_type"); ok(!$ouk->not_found, "not_found() uk 1 - $db_type"); is($ouk->ID, 1, "load() uk 2 - $db_type"); is($ouk->NAME, 'John', "load() uk 3 - $db_type"); ok($ouk->save, "save() uk 1 - $db_type"); my $o2 = MyMySQLObject->new(ID => $o->ID); ok(ref $o2 && $o2->isa('MyMySQLObject'), "new() 2 - $db_type"); is($o2->BITS->to_Bin, '00101', "BITS() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->NAME, $o->NAME, "load() verify 1 - $db_type"); is($o2->DATE_CREATED, $o->DATE_CREATED, "load() verify 2 - $db_type"); is($o2->LAST_MODIFIED, $o->LAST_MODIFIED, "load() verify 3 - $db_type"); is($o2->STATUS, 'active', "load() verify 4 (default value) - $db_type"); is($o2->FLAG, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->FLAG2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->SAVE_COL, 22, "load() verify 7 (aliased column) - $db_type"); is($o2->START->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->BITS->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); my $clone = $o2->clone; ok($o2->START eq $clone->START, "clone() 1 - $db_type"); $clone->START->set(year => '1960'); ok($o2->START ne $clone->START, "clone() 2 - $db_type"); $o2->NAME('John 2'); $o2->START('5/24/2001'); $o2->READ(99); sleep(1); # keep the last modified dates from being the same $o2->LAST_MODIFIED('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->DATE_CREATED, $o->DATE_CREATED, "save() verify 1 - $db_type"); ok($o2->LAST_MODIFIED ne $o->LAST_MODIFIED, "save() verify 2 - $db_type"); is($o2->START->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyMySQLObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyMySQLObject->new(ID => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); $o->NUMS([ 4, 5, 6 ]); ok($o->save, "save() 3 - $db_type"); ok($o->load, "load() 4 - $db_type"); is($o->NUMS->[0], 4, "load() verify 10 (array value) - $db_type"); is($o->NUMS->[1], 5, "load() verify 11 (array value) - $db_type"); is($o->NUMS->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o->NUMS; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); ok($o->delete, "delete() - $db_type"); $o = MyMySQLObject->new(NAME => 'John', ID => 9); $o->SAVE_COL(22); ok($o->save, "save() 4 - $db_type"); $o->SAVE_COL(50); ok($o->save, "save() 5 - $db_type"); $ouk = MyMySQLObject->new(SAVE_COL => 50); ok($ouk->load, "load() aliased unique key - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, "alias_column() nonesuch - $db_type"); # This is okay now #eval { $o->meta->alias_column(ID => 'foo') }; #ok($@, "alias_column() primary key - $db_type"); $o = MyMySQLObject->new(ID => 777); $o->meta->error_mode('fatal'); $o->dbh->{'PrintError'} = 0; eval { $o->load }; ok($@ && $o->not_found, "load() not found fatal - $db_type"); my $old_table = $o->meta->table; $o->meta->table('nonesuch'); eval { $o->load }; ok($@ && !$o->not_found, "load() fatal - $db_type"); eval { $o->save }; ok($@, "save() fatal - $db_type"); $o->meta->table($old_table); $o->meta->error_mode('return'); $o = MyMPKMySQLObject->new(NAME => 'John'); ok($o->save, "save() 1 multi-value primary key with generated values - $db_type"); is($o->K1, 1, "save() verify 1 multi-value primary key with generated values - $db_type"); is($o->K2, 2, "save() verify 2 multi-value primary key with generated values - $db_type"); $o = MyMPKMySQLObject->new(NAME => 'Alex'); ok($o->save, "save() 2 multi-value primary key with generated values - $db_type"); is($o->K1, 3, "save() verify 3 multi-value primary key with generated values - $db_type"); is($o->K2, 4, "save() verify 4 multi-value primary key with generated values - $db_type"); } # # Informix # SKIP: foreach my $db_type ('informix') { skip("Informix tests", 65) unless($HAVE_INFORMIX); Rose::DB->default_type($db_type); my $o = MyInformixObject->new(NAME => 'John', ID => 1, K1 => 1, K2 => undef, K3 => 3); ok(ref $o && $o->isa('MyInformixObject'), "new() 1 - $db_type"); #ok($o->can('id'), "no primary key alias - $db_type"); $o->meta->allow_inline_column_values(1); $o->FLAG2('true'); $o->DATE_CREATED('current year to fraction(5)'); $o->LAST_MODIFIED($o->DATE_CREATED); $o->SAVE_COL(22); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); $o->NAME('C' x 50); is($o->NAME, 'C' x 32, "varchar truncation - $db_type"); $o->NAME('John'); $o->CODE('A'); is($o->CODE, 'A ', "character padding - $db_type"); $o->CODE('C' x 50); is($o->CODE, 'C' x 6, "character truncation - $db_type"); my $os = Rose::DB::Object::Manager->get_objects( #debug => 1, object_class => ref($o), query => [ id => $o->ID, ]); is($os->[0]->ID, $o->ID, "Manager query with pk alias 1 - $db_type"); $os = Rose::DB::Object::Manager->get_objects( #debug => 1, object_class => ref($o), query => [ ID => $o->ID, ]); is($os->[0]->ID, $o->ID, "Manager query with pk alias 2 - $db_type"); my $ouk = MyInformixObject->new(K1 => 1, K2 => undef, K3 => 3); ok($ouk->load, "load() uk 1 - $db_type"); ok(!$ouk->not_found, "not_found() uk 1 - $db_type"); is($ouk->ID, 1, "load() uk 2 - $db_type"); is($ouk->NAME, 'John', "load() uk 3 - $db_type"); ok($ouk->save, "save() uk 1 - $db_type"); my $o2 = MyInformixObject->new(ID => $o->ID); ok(ref $o2 && $o2->isa('MyInformixObject'), "new() 2 - $db_type"); is($o2->BITS->to_Bin, '00101', "BITS() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->NAME, $o->NAME, "load() verify 1 - $db_type"); is($o2->DATE_CREATED, $o->DATE_CREATED, "load() verify 2 - $db_type"); is($o2->LAST_MODIFIED, $o->LAST_MODIFIED, "load() verify 3 - $db_type"); is($o2->STATUS, 'active', "load() verify 4 (default value) - $db_type"); is($o2->FLAG, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->FLAG2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->SAVE_COL, 22, "load() verify 7 (aliased column) - $db_type"); is($o2->START->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->BITS->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); my $clone = $o2->clone; ok($o2->START eq $clone->START, "clone() 1 - $db_type"); $clone->START->set(year => '1960'); ok($o2->START ne $clone->START, "clone() 2 - $db_type"); $o2->NAME('John 2'); $o2->START('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->LAST_MODIFIED('current year to second'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->DATE_CREATED, $o->DATE_CREATED, "save() verify 1 - $db_type"); ok($o2->LAST_MODIFIED ne $o->LAST_MODIFIED, "save() verify 2 - $db_type"); is($o2->START->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyInformixObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyInformixObject->new(ID => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); $o->NUMS([ 4, 5, 6 ]); $o->NAMES([ qw(a b 3.1) ]); ok($o->save, "save() 3 - $db_type"); ok($o->load, "load() 4 - $db_type"); is($o->NUMS->[0], 4, "load() verify 10 (array value) - $db_type"); is($o->NUMS->[1], 5, "load() verify 11 (array value) - $db_type"); is($o->NUMS->[2], 6, "load() verify 12 (array value) - $db_type"); $o->NUMS(7, 8, 9); my @a = $o->NUMS; is($a[0], 7, "load() verify 13 (array value) - $db_type"); is($a[1], 8, "load() verify 14 (array value) - $db_type"); is($a[2], 9, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); is($o->NAMES->[0], 'a', "load() verify 10 (set value) - $db_type"); is($o->NAMES->[1], 'b', "load() verify 11 (set value) - $db_type"); is($o->NAMES->[2], '3.1', "load() verify 12 (set value) - $db_type"); $o->NAMES('c', 'd', '4.2'); @a = $o->NAMES; is($a[0], 'c', "load() verify 13 (set value) - $db_type"); is($a[1], 'd', "load() verify 14 (set value) - $db_type"); is($a[2], '4.2', "load() verify 15 (set value) - $db_type"); is(@a, 3, "load() verify 16 (set value) - $db_type"); ok($o->delete, "delete() - $db_type"); $o = MyInformixObject->new(NAME => 'John', ID => 9); $o->FLAG2('true'); $o->DATE_CREATED('current year to fraction(5)'); $o->LAST_MODIFIED($o->DATE_CREATED); $o->SAVE_COL(22); ok($o->save, "save() 4 - $db_type"); $o->SAVE_COL(50); ok($o->save, "save() 5 - $db_type"); $ouk = MyInformixObject->new(SAVE_COL => 50); ok($ouk->load, "load() aliased unique key - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, "alias_column() nonesuch - $db_type"); # This is okay now #eval { $o->meta->alias_column(ID => 'foo') }; #ok($@, "alias_column() primary key - $db_type"); $o = MyInformixObject->new(ID => 777); $o->meta->error_mode('fatal'); $o->dbh->{'PrintError'} = 0; eval { $o->load }; ok($@ && $o->not_found, "load() not found fatal - $db_type"); $o->ID('abc'); eval { $o->load }; ok($@ && !$o->not_found, "load() fatal - $db_type"); eval { $o->save }; ok($@, "save() fatal - $db_type"); $o->meta->error_mode('return'); } # # SQLite # SKIP: foreach my $db_type ('sqlite') { skip("SQLite tests", 59) unless($HAVE_SQLITE); Rose::DB->default_type($db_type); my $o = MySQLiteObject->new(NAME => 'John', EYEDEE => 1, K1 => 1, K2 => undef, K3 => 3); ok(ref $o && $o->isa('MySQLiteObject'), "new() 1 - $db_type"); #ok($o->can('id'), "no primary key alias - $db_type"); $o->meta->allow_inline_column_values(1); $o->FLAG2('true'); $o->DATE_CREATED('now'); $o->LAST_MODIFIED($o->DATE_CREATED); $o->SAVE_COL(22); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); $o->NAME('C' x 50); is($o->NAME, 'C' x 32, "varchar truncation - $db_type"); $o->NAME('John'); $o->CODE('A'); is($o->CODE, 'A ', "character padding - $db_type"); $o->CODE('C' x 50); is($o->CODE, 'C' x 6, "character truncation - $db_type"); my $os = Rose::DB::Object::Manager->get_objects( #debug => 1, object_class => ref($o), query => [ id => $o->EYEDEE, ]); is($os->[0]->EYEDEE, $o->EYEDEE, "Manager query with pk alias 1 - $db_type"); $os = Rose::DB::Object::Manager->get_objects( #debug => 1, object_class => ref($o), query => [ EYEDEE => $o->EYEDEE, ]); is($os->[0]->EYEDEE, $o->EYEDEE, "Manager query with pk alias 2 - $db_type"); my $ouk = MySQLiteObject->new(K1 => 1, K2 => undef, K3 => 3); ok($ouk->load, "load() uk 1 - $db_type"); ok(!$ouk->not_found, "not_found() uk 1 - $db_type"); is($ouk->EYEDEE, 1, "load() uk 2 - $db_type"); is($ouk->NAME, 'John', "load() uk 3 - $db_type"); ok($ouk->save, "save() uk 1 - $db_type"); my $o2 = MySQLiteObject->new(EYEDEE => $o->EYEDEE); ok(ref $o2 && $o2->isa('MySQLiteObject'), "new() 2 - $db_type"); is($o2->BITS->to_Bin, '00101', "BITS() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->NAME, $o->NAME, "load() verify 1 - $db_type"); is($o2->DATE_CREATED, $o->DATE_CREATED, "load() verify 2 - $db_type"); is($o2->LAST_MODIFIED, $o->LAST_MODIFIED, "load() verify 3 - $db_type"); is($o2->STATUS, 'active', "load() verify 4 (default value) - $db_type"); is($o2->FLAG, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->FLAG2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->SAVE_COL, 22, "load() verify 7 (aliased column) - $db_type"); is($o2->START->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->BITS->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); my $clone = $o2->clone; ok($o2->START eq $clone->START, "clone() 1 - $db_type"); $clone->START->set(year => '1960'); ok($o2->START ne $clone->START, "clone() 2 - $db_type"); $o2->NAME('John 2'); $o2->START('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->LAST_MODIFIED('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->DATE_CREATED, $o->DATE_CREATED, "save() verify 1 - $db_type"); ok($o2->LAST_MODIFIED ne $o->LAST_MODIFIED, "save() verify 2 - $db_type"); is($o2->START->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MySQLiteObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MySQLiteObject->new(EYEDEE => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); $o->NUMS([ 4, 5, 6 ]); ok($o->save, "save() 3 - $db_type"); ok($o->load, "load() 4 - $db_type"); is($o->NUMS->[0], 4, "load() verify 10 (array value) - $db_type"); is($o->NUMS->[1], 5, "load() verify 11 (array value) - $db_type"); is($o->NUMS->[2], 6, "load() verify 12 (array value) - $db_type"); $o->NUMS(7, 8, 9); my @a = $o->NUMS; is($a[0], 7, "load() verify 13 (array value) - $db_type"); is($a[1], 8, "load() verify 14 (array value) - $db_type"); is($a[2], 9, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); ok($o->delete, "delete() - $db_type"); $o = MySQLiteObject->new(NAME => 'John', EYEDEE => 9); $o->FLAG2('true'); $o->DATE_CREATED('now'); $o->LAST_MODIFIED($o->DATE_CREATED); $o->SAVE_COL(22); ok($o->save, "save() 4 - $db_type"); $o->SAVE_COL(50); ok($o->save, "save() 5 - $db_type"); $ouk = MySQLiteObject->new(SAVE_COL => 50); ok($ouk->load, "load() aliased unique key - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, "alias_column() nonesuch - $db_type"); $o = MySQLiteObject->new(EYEDEE => 777); $o->meta->error_mode('fatal'); $o->dbh->{'PrintError'} = 0; eval { $o->load }; ok($@ && $o->not_found, "load() not found fatal - $db_type"); $o->EYEDEE('abc'); eval { $o->load }; # SQLite doesn't care about data types ok($@ && $o->not_found, "load() fatal - $db_type"); eval { $o->save }; ok($@, "save() fatal - $db_type"); $o->meta->error_mode('return'); # This is okay now eval { $o->meta->alias_column(id => 'foo') }; ok(!$@, "alias_column() primary key - $db_type"); } BEGIN { # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_PG = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_private.rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_chkpass_test'); $dbh->do('CREATE SCHEMA rose_db_object_private'); } our $PG_HAS_CHKPASS = pg_has_chkpass(); $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, k1 INT, k2 INT, k3 INT, @{[ $PG_HAS_CHKPASS ? 'passwd CHKPASS,' : '' ]} name VARCHAR(32) NOT NULL, code CHAR(6), flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bitz BIT(5) NOT NULL DEFAULT B'00101', start DATE, save INT, nums INT[], last_modified TIMESTAMP, date_created TIMESTAMP, UNIQUE(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_private.rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, k1 INT, k2 INT, k3 INT, @{[ $PG_HAS_CHKPASS ? 'passwd CHKPASS,' : '' ]} name VARCHAR(32) NOT NULL, code CHAR(6), flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bitz BIT(5) NOT NULL DEFAULT B'00101', start DATE, save INT, nums INT[], last_modified TIMESTAMP, date_created TIMESTAMP, UNIQUE(k1, k2, k3) ) EOF $dbh->disconnect; # Create test subclass package MyPgObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } MyPgObject->meta->table('rose_db_object_test'); my %chkpass_args = ( type => 'chkpass', alias => 'password', encrypted_suffix => '_ENCRYPTED', cmp_suffix => '_IS', ); MyPgObject->meta->columns ( name => { type => 'varchar', length => 32, overflow => 'truncate' }, code => { type => 'char', length => 6, overflow => 'truncate' }, id => { primary_key => 1, not_null => 1 }, k1 => { type => 'int' }, k2 => { type => 'int' }, k3 => { type => 'int' }, ($PG_HAS_CHKPASS ? (passwd => \%chkpass_args) : ()), flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, nums => { type => 'array' }, bitz => { type => 'bitfield', bits => 5, default => 101, alias => 'bits' }, #last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); MyPgObject->meta->add_unique_key('save'); MyPgObject->meta->add_unique_key([ qw(k1 k2 k3) ]); MyPgObject->meta->add_columns( Rose::DB::Object::Metadata::Column::Timestamp->new( name => 'last_modified')); MyPgObject->meta->column_name_to_method_name_mapper(sub { my($meta, $column_name, $method_type, $method_name) = @_; return uc $method_name; }); MyPgObject->meta->alias_column(save => 'save_col'); MyPgObject->meta->initialize; Test::More::is(MyPgObject->meta->column('id')->is_primary_key_member, 1, 'is_primary_key_member - pg'); Test::More::is(MyPgObject->meta->column('id')->primary_key_position, 1, 'primary_key_position 1 - pg'); Test::More::ok(!defined MyPgObject->meta->column('k1')->primary_key_position, 'primary_key_position 2 - pg'); MyPgObject->meta->column('k1')->primary_key_position(7); Test::More::ok(!defined MyPgObject->meta->column('k1')->primary_key_position, 'primary_key_position 3 - pg'); } # # MySQL # my $db_version; eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh() or die Rose::DB->error; $db_version = $db->database_version; }; if(!$@ && $dbh) { our $HAVE_MYSQL = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_test2'); } # MySQL 5.0.3 or later has a completely stupid "native" BIT type my $bit_col = ($db_version >= 5_000_003) ? q(bitz BIT(5) NOT NULL DEFAULT B'00101') : q(bitz BIT(5) NOT NULL DEFAULT '00101'); $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, k1 INT, k2 INT, k3 INT, name VARCHAR(32) NOT NULL, code CHAR(6), flag TINYINT(1) NOT NULL, flag2 TINYINT(1), status VARCHAR(32) DEFAULT 'active', $bit_col, nums VARCHAR(255), start DATE, save INT, `read` INT, last_modified TIMESTAMP, date_created TIMESTAMP, UNIQUE(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test2 ( k1 INT NOT NULL, k2 INT NOT NULL, name VARCHAR(32), UNIQUE(k1, k2) ) EOF $dbh->disconnect; # Create test subclass package MyMySQLObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } MyMySQLObject->meta->allow_inline_column_values(1); MyMySQLObject->meta->table('rose_db_object_test'); MyMySQLObject->meta->columns ( name => { type => 'varchar', length => 32, overflow => 'truncate' }, code => { type => 'char', length => 6, overflow => 'truncate' }, id => { primary_key => 1, not_null => 1 }, k1 => { type => 'int' }, k2 => { type => 'int' }, k3 => { type => 'int' }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, read => { type => 'int' }, nums => { type => 'array' }, bitz => { type => 'bitfield', bits => 5, default => 101, alias => 'bits' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); MyMySQLObject->meta->column_name_to_method_name_mapper(sub { my($meta, $column_name, $method_type, $method_name) = @_; return uc $method_name; }); MyMySQLObject->meta->alias_column(save => 'save_col'); MyMySQLObject->meta->add_unique_key('save'); MyMySQLObject->meta->add_unique_key([ qw(k1 k2 k3) ]); MyMySQLObject->meta->initialize(preserve_existing => 1); Test::More::is(MyMySQLObject->meta->column('id')->is_primary_key_member, 1, 'is_primary_key_member - mysql'); Test::More::is(MyMySQLObject->meta->column('id')->primary_key_position, 1, 'primary_key_position 1 - mysql'); Test::More::ok(!defined MyMySQLObject->meta->column('k1')->primary_key_position, 'primary_key_position 2 - mysql'); MyMySQLObject->meta->column('k1')->primary_key_position(7); Test::More::ok(!defined MyMySQLObject->meta->column('k1')->primary_key_position, 'primary_key_position 3 - mysql'); package MyMPKMySQLObject; use Rose::DB::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } MyMPKMySQLObject->meta->table('rose_db_object_test2'); MyMPKMySQLObject->meta->columns ( k1 => { type => 'int', not_null => 1 }, k2 => { type => 'int', not_null => 1 }, name => { type => 'varchar', length => 32 }, ); MyMPKMySQLObject->meta->primary_key_columns('k1', 'k2'); sub MyMPKMySQLObject::K1 { shift->k1(@_) } sub MyMPKMySQLObject::K2 { shift->k2(@_) } MyMPKMySQLObject->meta->column_name_to_method_name_mapper(sub { my($meta, $column_name, $method_type, $method_name) = @_; return $method_name =~ /^k[12]$/ ? $method_name : uc $method_name; }); MyMPKMySQLObject->meta->initialize; my $i = 1; MyMPKMySQLObject->meta->primary_key_generator(sub { my($meta, $db) = @_; my $k1 = $i++; my $k2 = $i++; return $k1, $k2; }); } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_INFORMIX = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, k1 INT, k2 INT, k3 INT, name VARCHAR(32) NOT NULL, code CHAR(6), flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bitz VARCHAR(5) DEFAULT '00101' NOT NULL, nums VARCHAR(255), start DATE, save INT, names SET(VARCHAR(64) NOT NULL), last_modified DATETIME YEAR TO FRACTION(5), date_created DATETIME YEAR TO FRACTION(5) ) EOF $dbh->disconnect; # Create test subclass package MyInformixObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('informix') } MyInformixObject->meta->table('rose_db_object_test'); MyInformixObject->meta->columns ( name => { type => 'varchar', length => 32, overflow => 'truncate' }, code => { type => 'char', length => 6, overflow => 'truncate' }, id => { type => 'serial', primary_key => 1, not_null => 1 }, k1 => { type => 'int' }, k2 => { type => 'int' }, k3 => { type => 'int' }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, nums => { type => 'array' }, bitz => { type => 'bitfield', bits => 5, default => 101, alias => 'bits' }, names => { type => 'set' }, last_modified => { type => 'timestamp' }, date_created => { type => 'datetime year to fraction(5)' }, ); MyInformixObject->meta->column_name_to_method_name_mapper(sub { my($meta, $column_name, $method_type, $method_name) = @_; return uc $method_name; }); MyInformixObject->meta->prepare_options({ix_CursorWithHold => 1}); MyInformixObject->meta->alias_column(save => 'save_col'); MyInformixObject->meta->add_unique_key('save'); MyInformixObject->meta->add_unique_key([ qw(k1 k2 k3) ]); MyInformixObject->meta->initialize; Test::More::is(MyInformixObject->meta->column('id')->is_primary_key_member, 1, 'is_primary_key_member - informix'); Test::More::is(MyInformixObject->meta->column('id')->primary_key_position, 1, 'primary_key_position 1 - informix'); Test::More::ok(!defined MyInformixObject->meta->column('k1')->primary_key_position, 'primary_key_position 2 - informix'); MyInformixObject->meta->column('k1')->primary_key_position(7); Test::More::ok(!defined MyInformixObject->meta->column('k1')->primary_key_position, 'primary_key_position 3 - informix'); } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_SQLITE = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INTEGER PRIMARY KEY AUTOINCREMENT, k1 INT, k2 INT, k3 INT, name VARCHAR(32) NOT NULL, code CHAR(6), flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bitz VARCHAR(5) DEFAULT '00101' NOT NULL, nums VARCHAR(255), start DATE, save INT, last_modified TIMESTAMP, date_created DATETIME ) EOF $dbh->disconnect; # Create test subclass package MySQLiteObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MySQLiteObject->meta->table('rose_db_object_test'); MySQLiteObject->meta->columns ( name => { type => 'varchar', length => 32, overflow => 'truncate' }, code => { type => 'char', length => 6, overflow => 'truncate' }, id => { type => 'serial', alias => 'eyedee', primary_key => 1, not_null => 1 }, k1 => { type => 'int' }, k2 => { type => 'int' }, k3 => { type => 'int' }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, nums => { type => 'array' }, bitz => { type => 'bitfield', bits => 5, default => 101, alias => 'bits' }, last_modified => { type => 'timestamp' }, date_created => { type => 'datetime' }, ); MySQLiteObject->meta->column_name_to_method_name_mapper(sub { my($meta, $column_name, $method_type, $method_name) = @_; return uc $method_name; }); MySQLiteObject->meta->prepare_options({ix_CursorWithHold => 1}); MySQLiteObject->meta->alias_column(save => 'save_col'); MySQLiteObject->meta->add_unique_key('save'); MySQLiteObject->meta->add_unique_key([ qw(k1 k2 k3) ]); MySQLiteObject->meta->initialize; Test::More::is(MySQLiteObject->meta->column('id')->is_primary_key_member, 1, 'is_primary_key_member - sqlite'); Test::More::is(MySQLiteObject->meta->column('id')->primary_key_position, 1, 'primary_key_position 1 - sqlite'); Test::More::ok(!defined MySQLiteObject->meta->column('k1')->primary_key_position, 'primary_key_position 2 - sqlite'); MySQLiteObject->meta->column('k1')->primary_key_position(7); Test::More::ok(!defined MySQLiteObject->meta->column('k1')->primary_key_position, 'primary_key_position 3 - sqlite'); } } END { # Delete test table if($HAVE_PG) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_private.rose_db_object_test'); $dbh->do('DROP SCHEMA rose_db_object_private CASCADE'); $dbh->disconnect; } if($HAVE_MYSQL) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_test2'); $dbh->disconnect; } if($HAVE_INFORMIX) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } if($HAVE_SQLITE) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-metadata.t000755 000765 000120 00000011716 11113677033 020256 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 36; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Metadata'); } my $meta = Rose::DB::Object::Metadata->new(class => 'MyDBObject'); my $meta2 = Rose::DB::Object::Metadata->for_class('MyDBObject'); is(ref $meta, 'Rose::DB::Object::Metadata', 'new()'); is(ref $meta2, 'Rose::DB::Object::Metadata', 'for_class'); is($meta, $meta2, 'new() & for_class()'); #$meta->schema('priv'); $meta->table('mytable'); #is($meta->schema, 'priv', 'schema()'); is($meta->table, 'mytable', 'table()'); is($meta->fq_table_sql(MyDBObject->init_db), 'rose_db_object_private.mytable', 'fq_table_sql()'); $meta->columns ( 'name', id => { primary_key => 1 }, password => { type => 'chkpass' }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, nums => { type => 'array' }, bits => { type => 'bitfield', bits => 5, default => 101 }, date_created => { type => 'timestamp' }, ); is($meta->first_column->name, 'name', 'first_column 1'); $meta->add_columns( Rose::DB::Object::Metadata::Column::Timestamp->new( name => 'last_modified')); ok(!$meta->column('foo'), 'column()'); $meta->add_column('foo'); ok($meta->column('foo'), 'add_column()'); $meta->add_columns('bar', baz => { type => 'bitfield', bits => 10 }); ok($meta->column('bar'), 'add_columns() 1'); ok($meta->column('baz'), 'add_columns() 2'); eval { $meta->initialize(preserve_existing => 1) }; ok($@, 'initialize() reserved method'); is($meta->column_aliases, undef, 'column_aliases() 1'); my $aliases = $meta->column_aliases; is($aliases, undef, 'column_aliases() 3'); $meta->alias_column(save => 'save_col'); $meta->initialize(preserve_existing => 1); is($meta->class_for(table => 'mytable'), 'MyDBObject', 'class_for() as object method'); is(Rose::DB::Object::Metadata->class_for(table => 'mytable'), 'MyDBObject', 'class_for() as class method'); is(join(',', sort $meta->column_names), 'bar,baz,bits,date_created,flag,flag2,foo,id,last_modified,name,nums,password,save,start,status', 'column_names'); $aliases = $meta->column_aliases; is(join(',', sort keys %$aliases), 'save', 'column_aliases() 3'); is($aliases->{'save'}, 'save_col', 'column_aliases() 4'); my $methods = $meta->column_rw_method_names; is(join(',', sort @$methods), 'bar,baz,bits,date_created,flag,flag2,foo,id,last_modified,name,nums,password,save_col,start,status', 'column_rw_method_names()'); eval { $meta->convention_manager('nonesuch') }; ok($@, 'convention_manager nonesuch'); $meta->convention_manager('null'); is(ref $meta->convention_manager, 'Rose::DB::Object::ConventionManager::Null', 'convention_manager null'); my $class = ref $meta; is($class->convention_manager_class('default'), 'Rose::DB::Object::ConventionManager', 'convention_manager default'); $class->convention_manager_class(foo => 'bar'); $class->convention_manager_class(default => 'Rose::DB::Object::ConventionManager::Null'); is($class->convention_manager_class('foo'), 'bar', 'convention_manager bar'); $class->delete_convention_manager_class('foo'); ok(!defined $class->convention_manager_class('foo'), 'delete_convention_manager_class'); is(ref $class->init_convention_manager, 'Rose::DB::Object::ConventionManager::Null', 'init_convention_manager'); $meta = MyDBOBjectCustom->meta; $meta->init_auto_helper; eval { $meta->make_column_methods() }; ok($@ =~ /^Yay!/, 'custom meta override'); # default_manager_base_class is($meta->default_manager_base_class, 'Rose::DB::Object::Manager', 'default_manager_base_class object 1'); is(ref($meta)->default_manager_base_class, 'Rose::DB::Object::Manager', 'default_manager_base_class class 1'); $meta->default_manager_base_class('Foo'); is($meta->default_manager_base_class, 'Foo', 'default_manager_base_class object 2'); is(ref($meta)->default_manager_base_class, 'Rose::DB::Object::Manager', 'default_manager_base_class class 2'); $meta->default_manager_base_class(undef); ref($meta)->default_manager_base_class('Bar'); is($meta->default_manager_base_class, 'Bar', 'default_manager_base_class object 3'); is(ref($meta)->default_manager_base_class, 'Bar', 'default_manager_base_class class 3'); $meta->default_manager_base_class('Blee'); is($meta->default_manager_base_class, 'Blee', 'default_manager_base_class object 4'); is(ref($meta)->default_manager_base_class, 'Bar', 'default_manager_base_class class 4'); BEGIN { package MyDBObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg_with_schema') } package MyDBObject::Metadata; our @ISA = qw(Rose::DB::Object::Metadata); sub make_column_methods { die "Yay!" } package MyDBObject::Base; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg_with_schema') } sub meta_class { 'MyDBObject::Metadata' } package MyDBOBjectCustom; our @ISA = qw(MyDBObject::Base); } 1;Rose-DB-Object-0.810/t/db-object-relationship-auto-2.t000755 000765 000120 00000037050 12054157213 022301 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; my $Iterations; BEGIN { $Iterations = 2 } use Test::More tests => 2 + (5 * 9 * $Iterations); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Manager'); } our %Have; # # Setup # # Some good test cases: #@Classes = qw(Color Price ProductColorMap Vendor Product); #@Classes = qw(Price ProductColorMap Product Color Vendor); #@Classes = qw(ProductColorMap Price Vendor Product Color); #@Classes = qw(Price Color Vendor ProductColorMap Product) my @Classes = qw(Vendor Product Price Color ProductColorMap); eval { require List::Util }; my $Can_Shuffle = $@ ? 0 : 1; my %Tables = ( Vendor => 'vendors', Product => 'products', Price => 'prices', Color => 'colors', ProductColorMap => 'product_color_map', ); my %Setup_Class; # # Tests # foreach my $i (1 .. $Iterations) { my @dbs = qw(mysql pg pg_with_schema informix sqlite); eval { require List::Util }; @dbs = List::Util::shuffle(@dbs) unless($@); # Good test orders: #@dbs = qw(sqlite pg_with_schema pg mysql informix); print "# db type order: @dbs\n"; foreach my $db_type (@dbs) { SKIP: { skip("$db_type tests", 9) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB->default_type($db_type); Rose::DB::Object::Metadata->unregister_all_classes; my $class_prefix = ucfirst($db_type eq 'pg_with_schema' ? 'pg' : $db_type) . $i; @Classes = List::Util::shuffle(@Classes) if($Can_Shuffle); print "# Class order: @Classes\n"; #$Rose::DB::Object::Metadata::Debug = 1; foreach my $class_root (@Classes) { my $class = $class_prefix . $class_root; if($Setup_Class{$class}++) { #$class->meta->init_with_db(Rose::DB->new); } else { no strict 'refs'; @{"${class}::ISA"} = qw(Rose::DB::Object); $class->meta->table($Tables{$class_root}); #$class->meta->init_with_db(Rose::DB->new); $class->meta->auto_initialize; } } my $product_class = $class_prefix . 'Product'; ## ## Run tests ## my $p = $product_class->new(name => "Sled $i"); $p->vendor(name => "Acme $i"); $p->prices({ price => 1.25, region => 'US' }, { price => 4.25, region => 'UK' }); $p->colors({ name => 'red' }, { name => 'green' }); $p->save; $p = $product_class->new(id => $p->id)->load; is($p->vendor->name, "Acme $i", "vendor $i.1 - $db_type"); my @prices = sort { $a->price <=> $b->price } $p->prices; is(scalar @prices, 2, "prices $i.1 - $db_type"); is($prices[0]->price, 1.25, "prices $i.2 - $db_type"); is($prices[1]->price, 4.25, "prices $i.3 - $db_type"); my @colors = sort { $a->name cmp $b->name } $p->colors; is(scalar @colors, 2, "colors $i.1 - $db_type"); is($colors[0]->name, 'green', "colors $i.2 - $db_type"); is($colors[1]->name, 'red', "colors $i.3 - $db_type"); #$DB::single = 1; #$Rose::DB::Object::Debug = 1; # # Test code generation # is($product_class->meta->perl_relationships_definition, <<"EOF", "perl_relationships_definition $i.1 - $db_type"); __PACKAGE__->meta->relationships( colors => { map_class => '${class_prefix}ProductColorMap', map_from => 'product', map_to => 'color', type => 'many to many', }, prices => { class => '${class_prefix}Price', column_map => { id => 'product_id' }, type => 'one to many', }, ); EOF is($product_class->meta->perl_relationships_definition(braces => 'bsd', indent => 2), <<"EOF", "perl_relationships_definition $i.2 - $db_type"); __PACKAGE__->meta->relationships ( colors => { map_class => '${class_prefix}ProductColorMap', map_from => 'product', map_to => 'color', type => 'many to many', }, prices => { class => '${class_prefix}Price', column_map => { id => 'product_id' }, type => 'one to many', }, ); EOF $product_class->meta_class->clear_all_dbs; } } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.product_color_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP NOT NULL DEFAULT NOW(), release_date TIMESTAMP, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT REFERENCES Rose_db_object_private.vendors (id), status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP NOT NULL DEFAULT NOW(), release_date TIMESTAMP, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES Rose_db_object_private.products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.product_color_map ( product_id INT NOT NULL REFERENCES Rose_db_object_private.products (id), color_id INT NOT NULL REFERENCES Rose_db_object_private.colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; die "MySQL version too old" unless($db->database_version >= 4_000_000); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } # Foreign key stuff requires InnoDB support $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF # MySQL will silently ignore the "ENGINE=InnoDB" part and create # a MyISAM table instead. MySQL is evil! Now we have to manually # check to make sure an InnoDB table was really created. my $db_name = $db->database; my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?"); $sth->execute('vendors'); my $info = $sth->fetchrow_hashref; no warnings 'uninitialized'; unless(lc $info->{'Type'} eq 'innodb' || lc $info->{'Engine'} eq 'innodb') { die "Missing InnoDB support"; } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE products ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT, status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP, release_date TIMESTAMP, UNIQUE(name), INDEX(vendor_id), FOREIGN KEY (vendor_id) REFERENCES vendors (id) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INT AUTO_INCREMENT PRIMARY KEY, product_id INT NOT NULL, region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region), INDEX(product_id), FOREIGN KEY (product_id) REFERENCES products (id) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL, color_id INT NOT NULL, PRIMARY KEY(product_id, color_id), INDEX(color_id), INDEX(product_id), FOREIGN KEY (product_id) REFERENCES products (id), FOREIGN KEY (color_id) REFERENCES colors (id) ) ENGINE=InnoDB EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) DEFAULT 'inactive' NOT NULL CHECK(status IN ('inactive', 'active', 'defunct')), date_created DATETIME YEAR TO SECOND, release_date DATETIME YEAR TO SECOND, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) DEFAULT 'inactive' NOT NULL CHECK(status IN ('inactive', 'active', 'defunct')), date_created DATETIME, release_date DATETIME, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INTEGER PRIMARY KEY AUTOINCREMENT, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } } END { # Delete test table if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.product_color_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if($Have{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if($Have{'sqlite'}) { # SQLite my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-relationship-auto.t000755 000765 000120 00000037002 12054157213 022137 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; my $Iterations; BEGIN { $Iterations = 2 } use Test::More tests => 2 + (5 * 9 * $Iterations); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Manager'); } our %Have; # # Setup # # Some good test cases: #@Classes = qw(Color Price ProductsColors Vendor Product); #@Classes = qw(Price ProductsColors Product Color Vendor); #@Classes = qw(ProductsColors Price Vendor Product Color); #@Classes = qw(Price Color Vendor ProductsColors Product) my @Classes = qw(Vendor Product Price Color ProductsColors); eval { require List::Util }; my $Can_Shuffle = $@ ? 0 : 1; my %Tables = ( Vendor => 'vendors', Product => 'products', Price => 'prices', Color => 'colors', ProductsColors => 'products_colors', ); my %Setup_Class; # # Tests # foreach my $i (1 .. $Iterations) { my @dbs = qw(mysql pg pg_with_schema informix sqlite); eval { require List::Util }; @dbs = List::Util::shuffle(@dbs) unless($@); # Good test orders: #@dbs = qw(sqlite pg_with_schema pg mysql informix); print "# db type order: @dbs\n"; foreach my $db_type (@dbs) { SKIP: { skip("$db_type tests", 9) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB->default_type($db_type); Rose::DB::Object::Metadata->unregister_all_classes; my $class_prefix = ucfirst($db_type eq 'pg_with_schema' ? 'pg' : $db_type) . $i; @Classes = List::Util::shuffle(@Classes) if($Can_Shuffle); print "# Class order: @Classes\n"; #$Rose::DB::Object::Metadata::Debug = 1; foreach my $class_root (@Classes) { my $class = $class_prefix . $class_root; if($Setup_Class{$class}++) { #$class->meta->init_with_db(Rose::DB->new); } else { no strict 'refs'; @{"${class}::ISA"} = qw(Rose::DB::Object); $class->meta->table($Tables{$class_root}); #$class->meta->init_with_db(Rose::DB->new); $class->meta->auto_initialize; } } my $product_class = $class_prefix . 'Product'; ## ## Run tests ## my $p = $product_class->new(name => "Sled $i"); $p->vendor(name => "Acme $i"); $p->prices({ price => 1.25, region => 'US' }, { price => 4.25, region => 'UK' }); $p->colors({ name => 'red' }, { name => 'green' }); $p->save; $p = $product_class->new(id => $p->id)->load; is($p->vendor->name, "Acme $i", "vendor $i.1 - $db_type"); my @prices = sort { $a->price <=> $b->price } $p->prices; is(scalar @prices, 2, "prices $i.1 - $db_type"); is($prices[0]->price, 1.25, "prices $i.2 - $db_type"); is($prices[1]->price, 4.25, "prices $i.3 - $db_type"); my @colors = sort { $a->name cmp $b->name } $p->colors; is(scalar @colors, 2, "colors $i.1 - $db_type"); is($colors[0]->name, 'green', "colors $i.2 - $db_type"); is($colors[1]->name, 'red', "colors $i.3 - $db_type"); #$DB::single = 1; #$Rose::DB::Object::Debug = 1; # # Test code generation # is($product_class->meta->perl_relationships_definition, <<"EOF", "perl_relationships_definition $i.1 - $db_type"); __PACKAGE__->meta->relationships( colors => { map_class => '${class_prefix}ProductsColors', map_from => 'product', map_to => 'color', type => 'many to many', }, prices => { class => '${class_prefix}Price', column_map => { id => 'product_id' }, type => 'one to many', }, ); EOF is($product_class->meta->perl_relationships_definition(braces => 'bsd', indent => 2), <<"EOF", "perl_relationships_definition $i.2 - $db_type"); __PACKAGE__->meta->relationships ( colors => { map_class => '${class_prefix}ProductsColors', map_from => 'product', map_to => 'color', type => 'many to many', }, prices => { class => '${class_prefix}Price', column_map => { id => 'product_id' }, type => 'one to many', }, ); EOF $product_class->meta_class->clear_all_dbs; } } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE products_colors CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products_colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP NOT NULL DEFAULT NOW(), release_date TIMESTAMP, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products_colors ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT REFERENCES Rose_db_object_private.vendors (id), status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP NOT NULL DEFAULT NOW(), release_date TIMESTAMP, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES Rose_db_object_private.products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.products_colors ( product_id INT NOT NULL REFERENCES Rose_db_object_private.products (id), color_id INT NOT NULL REFERENCES Rose_db_object_private.colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; die "MySQL version too old" unless($db->database_version >= 4_000_000); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE products_colors CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } # Foreign key stuff requires InnoDB support $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF # MySQL will silently ignore the "ENGINE=InnoDB" part and create # a MyISAM table instead. MySQL is evil! Now we have to manually # check to make sure an InnoDB table was really created. my $db_name = $db->database; my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?"); $sth->execute('vendors'); my $info = $sth->fetchrow_hashref; no warnings 'uninitialized'; unless(lc $info->{'Type'} eq 'innodb' || lc $info->{'Engine'} eq 'innodb') { die "Missing InnoDB support"; } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE products ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT, status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP, release_date TIMESTAMP, UNIQUE(name), INDEX(vendor_id), FOREIGN KEY (vendor_id) REFERENCES vendors (id) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INT AUTO_INCREMENT PRIMARY KEY, product_id INT NOT NULL, region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region), INDEX(product_id), FOREIGN KEY (product_id) REFERENCES products (id) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE products_colors ( product_id INT NOT NULL, color_id INT NOT NULL, PRIMARY KEY(product_id, color_id), INDEX(color_id), INDEX(product_id), FOREIGN KEY (product_id) REFERENCES products (id), FOREIGN KEY (color_id) REFERENCES colors (id) ) ENGINE=InnoDB EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE products_colors CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) DEFAULT 'inactive' NOT NULL CHECK(status IN ('inactive', 'active', 'defunct')), date_created DATETIME YEAR TO SECOND, release_date DATETIME YEAR TO SECOND, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products_colors ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE products_colors'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) DEFAULT 'inactive' NOT NULL CHECK(status IN ('inactive', 'active', 'defunct')), date_created DATETIME, release_date DATETIME, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INTEGER PRIMARY KEY AUTOINCREMENT, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products_colors ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } } END { # Delete test table if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE products_colors CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products_colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE products_colors CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if($Have{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE products_colors CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if($Have{'sqlite'}) { # SQLite my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE products_colors'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-relationship.t000755 000765 000120 00001004352 12054157213 021174 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 1603; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Manager'); } our($PG_HAS_CHKPASS, $HAVE_PG, $HAVE_MYSQL, $HAVE_INFORMIX, $HAVE_SQLITE); use FindBin qw($Bin); eval { require "$Bin/map-record-name-conflict.pl" }; ok($@ =~ /^\QAlready made a map record method named map_record in class JCS::B on behalf of the relationship 'bs' in class JCS::A. Please choose another name for the map record method for the relationship named 'bs' in JCS::C.\E/, 'many-to-many map record name conflict'); # # PostgreSQL # SKIP: foreach my $db_type ('pg') { skip("PostgreSQL tests", 398) unless($HAVE_PG); Rose::DB->default_type($db_type); my $o = MyPgObject->new(name => 'John'); ok(ref $o && $o->isa('MyPgObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(7); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); my $o_x = MyPgObject->new(id => 99, name => 'John X', flag => 0); $o_x->save; my $o2 = MyPgObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyPgObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 7, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyPgObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyPgObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->load, "load() 4 - $db_type"); SKIP: { if($PG_HAS_CHKPASS) { $o->{'password_encrypted'} = ':8R1Kf2nOS0bRE'; ok($o->password_is('xyzzy'), "chkpass() 1 - $db_type"); is($o->password, 'xyzzy', "chkpass() 2 - $db_type"); $o->password('foobar'); ok($o->password_is('foobar'), "chkpass() 3 - $db_type"); is($o->password, 'foobar', "chkpass() 4 - $db_type"); ok($o->save, "save() 3 - $db_type"); } else { skip("chkpass tests", 5); } } my $o5 = MyPgObject->new(id => $o->id); ok($o5->load, "load() 5 - $db_type"); SKIP: { if($PG_HAS_CHKPASS) { ok($o5->password_is('foobar'), "chkpass() 5 - $db_type"); is($o5->password, 'foobar', "chkpass() 6 - $db_type"); } else { skip("chkpass tests", 2); } } $o5->nums([ 4, 5, 6 ]); ok($o5->save, "save() 4 - $db_type"); ok($o->load, "load() 6 - $db_type"); is($o5->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o5->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o5->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o5->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); my $oo1 = MyPgOtherObject->new(k1 => 1, k2 => 2, k3 => 3, name => 'one'); ok($oo1->save, "other object save() 1 - $db_type"); my $oo2 = MyPgOtherObject->new(k1 => 11, k2 => 12, k3 => 13, name => 'two'); ok($oo2->save, "other object save() 2 - $db_type"); is($o->other_obj, undef, "other_obj() 1 - $db_type"); $o->fkone(99); $o->fk2(99); $o->fk3(99); eval { $o->other_obj }; ok($@, "fatal referential_integrity - $db_type"); ok(!defined $o->other_obj_osoft, "ok referential_integrity 1 - $db_type"); ok(!defined $o->other_obj_msoft, "ok referential_integrity 2 - $db_type"); $o->fkone(1); $o->fk2(2); $o->fk3(3); my $obj = $o->other_obj or warn "# ", $o->error, "\n"; is(ref $obj, 'MyPgOtherObject', "other_obj() 2 - $db_type"); is($obj->name, 'one', "other_obj() 3 - $db_type"); is($obj->db, $o->db, "share_db (default true) - $db_type"); $o->other_obj(undef); $o->fkone(11); $o->fk2(12); $o->fk3(13); ok(!$o->has_loaded_related('other_obj'), "has_loaded_related() 1 - $db_type"); $obj = $o->other_obj or warn "# ", $o->error, "\n"; ok($o->has_loaded_related('other_obj'), "has_loaded_related() 2 - $db_type"); $o->forget_related('other_obj'); ok(!$o->has_loaded_related('other_obj'), "forget_related() 1 - $db_type"); $obj = $o->other_obj or warn "# ", $o->error, "\n"; ok($o->has_loaded_related('other_obj'), "forget_related() 2 - $db_type"); eval { $o->forget_related(foreign_key => 'other_obj_nonesuch') }; ok($@, "forget_related() 3 - $db_type"); $o->forget_related(relationship => 'other_obj'); ok(!$o->has_loaded_related('other_obj'), "forget_related() 4 - $db_type"); $obj = $o->other_obj or warn "# ", $o->error, "\n"; is(ref $obj, 'MyPgOtherObject', "other_obj() 4 - $db_type"); is($obj->name, 'two', "other_obj() 5 - $db_type"); my $oo21 = MyPgOtherObject2->new(id => 1, name => 'one', pid => $o->id); ok($oo21->save, "other object 2 save() 1 - $db_type"); my $oo22 = MyPgOtherObject2->new(id => 2, name => 'two', pid => $o->id); ok($oo22->save, "other object 2 save() 2 - $db_type"); my $oo23 = MyPgOtherObject2->new(id => 3, name => 'three', pid => $o_x->id); ok($oo23->save, "other object 2 save() 3 - $db_type"); # Begin filtered collection tests my $x = MyPgObject->new(id => $o->id)->load; $x->other2_a_objs({ id => 100, name => 'aoo' }, { id => 101, name => 'abc' }); $x->save; $x = MyPgObject->new(id => $o->id)->load; my $ao = $x->other2_a_objs; my $oo = $x->other2_objs; is(scalar @$ao, 2, "filtered one-to-many 1 - $db_type"); is(join(',', map { $_->name } @$ao), 'abc,aoo', "filtered one-to-many 2 - $db_type"); is(scalar @$oo, 4, "filtered one-to-many 3 - $db_type"); is(join(',', sort map { $_->name } @$oo), 'abc,aoo,one,two', "filtered one-to-many 4 - $db_type"); $x->other2_a_objs({ id => 102, name => 'axx' }); $x->save; $x = MyPgObject->new(id => $o->id)->load; $ao = $x->other2_a_objs; $oo = $x->other2_objs; is(scalar @$ao, 1, "filtered one-to-many 5 - $db_type"); is(join(',', map { $_->name } @$ao), 'axx', "filtered one-to-many 6 - $db_type"); is(scalar @$oo, 3, "filtered one-to-many 7 - $db_type"); is(join(',', sort map { $_->name } @$oo), 'axx,one,two', "filtered one-to-many 8 - $db_type"); $x->other2_a_objs([]); $x->save; # End filtered collection tests ok(!$o->has_loaded_related('other2_objs'), "has_loaded_related() 3 - $db_type"); my $o2s = $o->other2_objs; ok($o->has_loaded_related('other2_objs'), "has_loaded_related() 4 - $db_type"); ok(ref $o2s eq 'ARRAY' && @$o2s == 2 && $o2s->[0]->name eq 'two' && $o2s->[1]->name eq 'one', 'other objects 1'); my @o2s = $o->other2_objs; ok(@o2s == 2 && $o2s[0]->name eq 'two' && $o2s[1]->name eq 'one', 'other objects 2'); my $color = MyPgColor->new(id => 1, name => 'red'); ok($color->save, "save color 1 - $db_type"); $color = MyPgColor->new(id => 2, name => 'green'); ok($color->save, "save color 2 - $db_type"); $color = MyPgColor->new(id => 3, name => 'blue'); ok($color->save, "save color 3 - $db_type"); $color = MyPgColor->new(id => 4, name => 'pink'); ok($color->save, "save color 4 - $db_type"); my $map1 = MyPgColorMap->new(obj_id => 1, color_id => 1); ok($map1->save, "save color map record 1 - $db_type"); my $map2 = MyPgColorMap->new(obj_id => 1, color_id => 3); ok($map2->save, "save color map record 2 - $db_type"); my $map3 = MyPgColorMap->new(obj_id => 99, color_id => 4); ok($map3->save, "save color map record 3 - $db_type"); my $colors = $o->colors; ok(ref $colors eq 'ARRAY' && @$colors == 2 && $colors->[0]->name eq 'blue' && $colors->[1]->name eq 'red', "colors 1 - $db_type"); $colors = $o->find_colors; ok(ref $colors eq 'ARRAY' && @$colors == 2 && $colors->[0]->name eq 'blue' && $colors->[1]->name eq 'red', "find colors 1 - $db_type"); $colors = $o->find_colors([ name => { like => 'r%' } ]); ok(ref $colors eq 'ARRAY' && @$colors == 1 && $colors->[0]->name eq 'red', "find colors 2 - $db_type"); $colors = $o->find_colors(query => [ name => { like => 'r%' } ], cache => 1); my $colors2 = $o->find_colors(from_cache => 1); ok(ref $colors eq 'ARRAY' && @$colors == 1 && $colors->[0]->name eq 'red' && ref $colors2 eq 'ARRAY' && @$colors2 == 1 && $colors2->[0]->name eq 'red' && $colors->[0] eq $colors2->[0], "find colors from cache - $db_type"); my $count = $o->colors_count; is($count, 2, "count colors 1 - $db_type"); $count = $o->colors_count([ name => { like => 'r%' } ]); is($count, 1, "count colors 2 - $db_type"); my @colors = $o->colors; ok(@colors == 2 && $colors[0]->name eq 'blue' && $colors[1]->name eq 'red', "colors 2 - $db_type"); $colors = $o_x->colors; ok(ref $colors eq 'ARRAY' && @$colors == 1 && $colors->[0]->name eq 'pink', "colors 3 - $db_type"); @colors = $o_x->colors; ok(@colors == 1 && $colors[0]->name eq 'pink', "colors 4 - $db_type"); $o = MyPgObject->new(id => 1)->load; $o->fkone(1); $o->fk2(2); $o->fk3(3); $o->save; #local $Rose::DB::Object::Manager::Debug = 1; eval { local $o->dbh->{'PrintError'} = 0; $o->delete(cascade => 'null'); }; ok($@, "delete cascade null 1 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( db => $o->db, object_class => 'MyPgOtherObject'); is($count, 2, "delete cascade rollback confirm 1 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( db => $o->db, object_class => 'MyPgOtherObject2'); is($count, 3, "delete cascade rollback confirm 2 - $db_type"); ok($o->delete(cascade => 'delete'), "delete cascade delete 1 - $db_type"); $o = MyPgObject->new(id => 99)->load; $o->fkone(11); $o->fk2(12); $o->fk3(13); $o->save; eval { local $o->dbh->{'PrintError'} = 0; $o->delete(cascade => 'null'); }; ok($@, "delete cascade null 2 - $db_type"); ok($o->delete(cascade => 'delete'), "delete cascade delete 2 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( db => $o->db, object_class => 'MyPgColorMap'); is($count, 0, "delete cascade confirm 1 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( db => $o->db, object_class => 'MyPgOtherObject2'); is($count, 0, "delete cascade confirm 2 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( db => $o->db, object_class => 'MyPgOtherObject'); is($count, 0, "delete cascade confirm 3 - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, "alias_column() nonesuch - $db_type"); # Start foreign key method tests # # Foreign key get_set_now # $o = MyPgObject->new(id => 50, name => 'Alex', flag => 1); eval { $o->other_obj('abc') }; ok($@, "set foreign key object: one arg - $db_type"); eval { $o->other_obj(k1 => 1, k2 => 2, k3 => 3) }; ok($@, "set foreign key object: no save - $db_type"); $o->save; eval { local $o->db->dbh->{'PrintError'} = 0; $o->other_obj(k1 => 1, k2 => 2); }; ok($@, "set foreign key object: too few keys - $db_type"); ok($o->other_obj(k1 => 1, k2 => 2, k3 => 3), "set foreign key object 1 - $db_type"); ok($o->fkone == 1 && $o->fk2 == 2 && $o->fk3 == 3, "set foreign key object check keys 1 - $db_type"); ok($o->other_obj(k1 => 1, k2 => 2, k3 => 3), "set foreign key object 2 - $db_type"); ok($o->fkone == 1 && $o->fk2 == 2 && $o->fk3 == 3, "set foreign key object check keys 2 - $db_type"); # # Foreign key delete_now # ok($o->delete_other_obj, "delete foreign key object 1 - $db_type"); ok(!defined $o->fkone && !defined $o->fk2 && !defined $o->fk3, "delete foreign key object check keys 1 - $db_type"); ok(!defined $o->other_obj && defined $o->error, "delete foreign key object confirm 1 - $db_type"); ok(!defined $o->delete_other_obj, "delete foreign key object 2 - $db_type"); # # Foreign key get_set_on_save # # TEST: Set, save $o = MyPgObject->new(id => 100, name => 'Bub', flag => 1); ok($o->other_obj_on_save(k1 => 21, k2 => 22, k3 => 23), "set foreign key object on save 1 - $db_type"); my $co = MyPgObject->new(id => 100); ok(!$co->load(speculative => 1), "set foreign key object on save 2 - $db_type"); my $other_obj = $o->other_obj_on_save; ok($other_obj && $other_obj->k1 == 21 && $other_obj->k2 == 22 && $other_obj->k3 == 23, "set foreign key object on save 3 - $db_type"); ok($o->save, "set foreign key object on save 4 - $db_type"); $o = MyPgObject->new(id => 100); $o->load; $other_obj = $o->other_obj_on_save; ok($other_obj && $other_obj && $other_obj->k1 == 21 && $other_obj->k2 == 22 && $other_obj->k3 == 23, "set foreign key object on save 5 - $db_type"); # TEST: Set, set to undef, save $o = MyPgObject->new(id => 200, name => 'Rose', flag => 1); ok($o->other_obj_on_save(k1 => 51, k2 => 52, k3 => 53), "set foreign key object on save 6 - $db_type"); $co = MyPgObject->new(id => 200); ok(!$co->load(speculative => 1), "set foreign key object on save 7 - $db_type"); $other_obj = $o->other_obj_on_save; ok($other_obj && $other_obj->k1 == 51 && $other_obj->k2 == 52 && $other_obj->k3 == 53, "set foreign key object on save 8 - $db_type"); $o->other_obj_on_save(undef); ok($o->save, "set foreign key object on save 9 - $db_type"); $o = MyPgObject->new(id => 200); $o->load; ok(!defined $o->other_obj_on_save, "set foreign key object on save 10 - $db_type"); $co = MyPgOtherObject->new(k1 => 51, k2 => 52, k3 => 53); ok(!$co->load(speculative => 1), "set foreign key object on save 11 - $db_type"); $o->delete(cascade => 1); # TEST: Set, delete, save $o = MyPgObject->new(id => 200, name => 'Rose', flag => 1); ok($o->other_obj_on_save(k1 => 51, k2 => 52, k3 => 53), "set foreign key object on save 12 - $db_type"); $co = MyPgObject->new(id => 200); ok(!$co->load(speculative => 1), "set foreign key object on save 13 - $db_type"); $other_obj = $o->other_obj_on_save; ok($other_obj && $other_obj->k1 == 51 && $other_obj->k2 == 52 && $other_obj->k3 == 53, "set foreign key object on save 14 - $db_type"); ok($o->delete_other_obj, "set foreign key object on save 15 - $db_type"); $other_obj = $o->other_obj_on_save; ok(!defined $other_obj && !defined $o->fkone && !defined $o->fk2 && !defined $o->fk3, "set foreign key object on save 16 - $db_type"); ok($o->save, "set foreign key object on save 17 - $db_type"); $o = MyPgObject->new(id => 200); $o->load; ok(!defined $o->other_obj_on_save, "set foreign key object on save 18 - $db_type"); $co = MyPgOtherObject->new(k1 => 51, k2 => 52, k3 => 53); ok(!$co->load(speculative => 1), "set foreign key object on save 19 - $db_type"); $o->delete(cascade => 1); # # Foreign key delete_on_save # $o = MyPgObject->new(id => 500, name => 'Kip', flag => 1); $o->other_obj_on_save(k1 => 7, k2 => 8, k3 => 9); $o->save; $o = MyPgObject->new(id => 500); $o->load; # TEST: Delete, save $o->del_other_obj_on_save; $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are undef... ok(!defined $other_obj && !defined $o->fkone && !defined $o->fk2 && !defined $o->fk3, "delete foreign key object on save 1 - $db_type"); # ...but that the foreign object has not yet been deleted $co = MyPgOtherObject->new(k1 => 7, k2 => 8, k3 => 9); ok($co->load(speculative => 1), "delete foreign key object on save 2 - $db_type"); # Do the save ok($o->save, "delete foreign key object on save 3 - $db_type"); # Now it's deleted $co = MyPgOtherObject->new(k1 => 7, k2 => 8, k3 => 9); ok(!$co->load(speculative => 1), "delete foreign key object on save 4 - $db_type"); $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are undef ok(!defined $other_obj && !defined $o->fkone && !defined $o->fk2 && !defined $o->fk3, "delete foreign key object on save 5 - $db_type"); # RESET $o->delete; $o = MyPgObject->new(id => 700, name => 'Ham', flag => 0); $o->other_obj_on_save(k1 => 12, k2 => 34, k3 => 56); $o->save; $o = MyPgObject->new(id => 700); $o->load; # TEST: Delete, set on save, delete, save ok($o->del_other_obj_on_save, "delete 2 foreign key object on save 1 - $db_type"); $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are undef... ok(!defined $other_obj && !defined $o->fkone && !defined $o->fk2 && !defined $o->fk3, "delete 2 foreign key object on save 2 - $db_type"); # ...but that the foreign object has not yet been deleted $co = MyPgOtherObject->new(k1 => 12, k2 => 34, k3 => 56); ok($co->load(speculative => 1), "delete 3 foreign key object on save 3 - $db_type"); # Set on save $o->other_obj_on_save(k1 => 44, k2 => 55, k3 => 66); $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are set... ok($other_obj && $other_obj->k1 == 44 && $other_obj->k2 == 55 && $other_obj->k3 == 66, "delete 2 foreign key object on save 4 - $db_type"); # ...and that the foreign object has not yet been saved $co = MyPgOtherObject->new(k1 => 44, k2 => 55, k3 => 66); ok(!$co->load(speculative => 1), "delete 2 foreign key object on save 5 - $db_type"); # Delete again ok($o->del_other_obj_on_save, "delete 2 foreign key object on save 6 - $db_type"); $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are undef... ok(!defined $other_obj && !defined $o->fkone && !defined $o->fk2 && !defined $o->fk3, "delete 2 foreign key object on save 7 - $db_type"); # Confirm that the foreign objects have not been saved $co = MyPgOtherObject->new(k1 => 7, k2 => 8, k3 => 9); ok(!$co->load(speculative => 1), "delete 2 foreign key object on save 8 - $db_type"); $co = MyPgOtherObject->new(k1 => 44, k2 => 55, k3 => 66); ok(!$co->load(speculative => 1), "delete 2 foreign key object on save 9 - $db_type"); # RESET $o->delete; $o = MyPgObject->new(id => 800, name => 'Lee', flag => 1); $o->other_obj_on_save(k1 => 12, k2 => 34, k3 => 56); $o->save; $o = MyPgObject->new(id => 800); $o->load; # TEST: Set & save, delete on save, set on save, delete on save, save ok($o->other_obj(k1 => 1, k2 => 2, k3 => 3), "delete 3 foreign key object on save 1 - $db_type"); # Confirm that both foreign objects are in the db $co = MyPgOtherObject->new(k1 => 12, k2 => 34, k3 => 56); ok($co->load(speculative => 1), "delete 3 foreign key object on save 2 - $db_type"); $co = MyPgOtherObject->new(k1 => 1, k2 => 2, k3 => 3); ok($co->load(speculative => 1), "delete 3 foreign key object on save 3 - $db_type"); # Delete on save $o->del_other_obj_on_save; # Set-on-save to old value $o->other_obj_on_save(k1 => 12, k2 => 34, k3 => 56); # Delete on save $o->del_other_obj_on_save; # Save $o->save; # Confirm that both foreign objects have been deleted $co = MyPgOtherObject->new(k1 => 12, k2 => 34, k3 => 56); ok(!$co->load(speculative => 1), "delete 3 foreign key object on save 4 - $db_type"); $co = MyPgOtherObject->new(k1 => 1, k2 => 2, k3 => 3); ok(!$co->load(speculative => 1), "delete 3 foreign key object on save 5 - $db_type"); # RESET $o->delete; $o = MyPgObject->new(id => 900, name => 'Kai', flag => 1); $o->other_obj_on_save(k1 => 12, k2 => 34, k3 => 56); $o->save; $o = MyPgObject->new(id => 900); $o->load; # TEST: Delete on save, set on save, delete on save, set to same one, save $o->del_other_obj_on_save; # Set on save ok($o->other_obj_on_save(k1 => 1, k2 => 2, k3 => 3), "delete 4 foreign key object on save 1 - $db_type"); # Delete on save $o->del_other_obj_on_save; # Set-on-save to previous value $o->other_obj_on_save(k1 => 1, k2 => 2, k3 => 3); # Save $o->save; $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are set... ok($other_obj && $other_obj->k1 == 1 && $other_obj->k2 == 2 && $other_obj->k3 == 3, "delete 4 foreign key object on save 2 - $db_type"); # Confirm that the new foreign object is there and the old one is not $co = MyPgOtherObject->new(k1 => 1, k2 => 2, k3 => 3); ok($co->load(speculative => 1), "delete 4 foreign key object on save 3 - $db_type"); $co = MyPgOtherObject->new(k1 => 12, k2 => 34, k3 => 56); ok(!$co->load(speculative => 1), "delete 4 foreign key object on save 4 - $db_type"); # End foreign key method tests # Start "one to many" method tests # # "one to many" get_set_now # # SETUP $o = MyPgObject->new(id => 111, name => 'Boo', flag => 1); MyPgOtherObject2->new(id => 1, name => 'one', pid => 900)->save; @o2s = ( 1, MyPgOtherObject2->new(id => 2, name => 'two'), { id => 3, name => 'three', pid => 111 }, ); # Set before save, save, set eval { $o->other2_objs_now(@o2s) }; ok($@, "set one to many now 1 - $db_type"); $o->save; ok($o->other2_objs_now(@o2s), "set one to many now 2 - $db_type"); @o2s = $o->other2_objs_now; ok(@o2s == 3, "set one to many now 3 - $db_type"); ok($o2s[0]->id == 2 && $o2s[0]->pid == 111, "set one to many now 4 - $db_type"); ok($o2s[1]->id == 3 && $o2s[1]->pid == 111, "set one to many now 5 - $db_type"); ok($o2s[2]->id == 1 && $o2s[2]->pid == 111, "set one to many now 6 - $db_type"); $o2 = MyPgOtherObject2->new(id => 1)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 7 - $db_type"); $o2 = MyPgOtherObject2->new(id => 2)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 8 - $db_type"); $o2 = MyPgOtherObject2->new(id => 3)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 9 - $db_type"); my $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_other2 WHERE pid = 111'); $sth->execute; $count = $sth->fetchrow_array; is($count, 3, "set one to many now 10 - $db_type"); # Set to undef $o->other2_objs_now(undef); @o2s = $o->other2_objs_now; ok(@o2s == 3, "set one to many now 11 - $db_type"); ok($o2s[0]->id == 2 && $o2s[0]->pid == 111, "set one to many now 12 - $db_type"); ok($o2s[1]->id == 3 && $o2s[1]->pid == 111, "set one to many now 13 - $db_type"); ok($o2s[2]->id == 1 && $o2s[2]->pid == 111, "set one to many now 14 - $db_type"); $o2 = MyPgOtherObject2->new(id => 1)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 15 - $db_type"); $o2 = MyPgOtherObject2->new(id => 2)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 16 - $db_type"); $o2 = MyPgOtherObject2->new(id => 3)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 17 - $db_type"); # RESET $o = MyPgObject->new(id => 111)->load; # Set (one existing, one new) @o2s = ( MyPgOtherObject2->new(id => 1, name => 'one'), MyPgOtherObject2->new(id => 7, name => 'seven'), ); ok($o->other2_objs_now(\@o2s), "set 2 one to many now 1 - $db_type"); $o2 = MyPgOtherObject2->new(id => 7)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many now 2 - $db_type"); $o2 = MyPgOtherObject2->new(id => 1)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many now 3 - $db_type"); @o2s = $o->other2_objs_now; ok(@o2s == 2, "set 2 one to many now 4 - $db_type"); ok($o2s[0]->id == 7 && $o2s[0]->pid == 111, "set 2 one to many now 5 - $db_type"); ok($o2s[1]->id == 1 && $o2s[1]->pid == 111, "set 2 one to many now 6 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_other2 WHERE pid = 111'); $sth->execute; $count = $sth->fetchrow_array; is($count, 2, "set 2 one to many now 7 - $db_type"); # # "one to many" get_set_on_save # # SETUP $o2->db->dbh->do('DELETE FROM rose_db_object_other2'); $o = MyPgObject->new(id => 222, name => 'Hap', flag => 1); @o2s = ( MyPgOtherObject2->new(id => 5, name => 'five'), MyPgOtherObject2->new(id => 6, name => 'six'), MyPgOtherObject2->new(id => 7, name => 'seven'), ); $o->other2_objs_on_save(@o2s); @o2s = $o->other2_objs_on_save; ok(@o2s == 3, "set one to many on save 1 - $db_type"); ok($o2s[0]->id == 5 && $o2s[0]->pid == 222, "set one to many on save 2 - $db_type"); ok($o2s[1]->id == 6 && $o2s[1]->pid == 222, "set one to many on save 3 - $db_type"); ok($o2s[2]->id == 7 && $o2s[2]->pid == 222, "set one to many on save 4 - $db_type"); ok(!MyPgOtherObject2->new(id => 5)->load(speculative => 1), "set one to many on save 5 - $db_type"); ok(!MyPgOtherObject2->new(id => 6)->load(speculative => 1), "set one to many on save 6 - $db_type"); ok(!MyPgOtherObject2->new(id => 7)->load(speculative => 1), "set one to many on save 7 - $db_type"); $o->save; @o2s = $o->other2_objs_on_save; ok(@o2s == 3, "set one to many on save 8 - $db_type"); ok($o2s[0]->id == 6 && $o2s[0]->pid == 222, "set one to many on save 9 - $db_type"); ok($o2s[1]->id == 7 && $o2s[1]->pid == 222, "set one to many on save 10 - $db_type"); ok($o2s[2]->id == 5 && $o2s[2]->pid == 222, "set one to many on save 11 - $db_type"); $o2 = MyPgOtherObject2->new(id => 5)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many on save 12 - $db_type"); $o2 = MyPgOtherObject2->new(id => 6)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many on save 13 - $db_type"); $o2 = MyPgOtherObject2->new(id => 7)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many on save 14 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_other2 WHERE pid = 222'); $sth->execute; $count = $sth->fetchrow_array; is($count, 3, "set one to many on save 15 - $db_type"); # RESET $o = MyPgObject->new(id => 222)->load; # Set (one existing, one new) @o2s = ( MyPgOtherObject2->new(id => 7, name => 'seven'), MyPgOtherObject2->new(id => 12, name => 'one'), ); ok($o->other2_objs_on_save(\@o2s), "set 2 one to many on save 1 - $db_type"); $o2 = MyPgOtherObject2->new(id => 7)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many on save 2 - $db_type"); ok(!MyPgOtherObject2->new(id => 12)->load(speculative => 1), "set 2 one to many on save 3 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_other2 WHERE pid = 222'); $sth->execute; $count = $sth->fetchrow_array; is($count, 3, "set 2 one to many on save 4 - $db_type"); @o2s = $o->other2_objs_on_save; ok(@o2s == 2, "set 2 one to many on save 5 - $db_type"); ok($o2s[0]->id == 7 && $o2s[0]->pid == 222, "set 2 one to many on save 6 - $db_type"); ok($o2s[1]->id == 12 && $o2s[1]->pid == 222, "set 2 one to many on save 7 - $db_type"); $o->save; @o2s = $o->other2_objs_on_save; ok(@o2s == 2, "set one to many on save 8 - $db_type"); ok($o2s[0]->id == 7 && $o2s[0]->pid == 222, "set 2 one to many on save 9 - $db_type"); ok($o2s[1]->id == 12 && $o2s[1]->pid == 222, "set 2 one to many on save 10 - $db_type"); $o2 = MyPgOtherObject2->new(id => 7)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many on save 11 - $db_type"); $o2 = MyPgOtherObject2->new(id => 12)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many on save 12 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_other2 WHERE pid = 222'); $sth->execute; $count = $sth->fetchrow_array; is($count, 2, "set one to many on save 15 - $db_type"); # Set to undef $o->other2_objs_on_save(undef); @o2s = $o->other2_objs_on_save; ok(@o2s == 2, "set one to many on save 16 - $db_type"); ok($o2s[0]->id == 7 && $o2s[0]->pid == 222, "set 2 one to many on save 17 - $db_type"); ok($o2s[1]->id == 12 && $o2s[1]->pid == 222, "set 2 one to many on save 18 - $db_type"); $o2 = MyPgOtherObject2->new(id => 7)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many on save 19 - $db_type"); $o2 = MyPgOtherObject2->new(id => 12)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many on save 20 - $db_type"); $o->save; @o2s = $o->other2_objs_on_save; push(@o2s, MyPgOtherObject2->new(name => 'added')); $o->other2_objs_on_save(\@o2s); $o->save; my $to = MyPgObject->new(id => $o->id)->load; @o2s = $o->other2_objs_on_save; is_deeply([ 'seven', 'one', 'added' ], [ map { $_->name } @o2s ], "add one to many on save 1 - $db_type"); # # "one to many" add_now # # SETUP $o2->db->dbh->do('DELETE FROM rose_db_object_other2'); $o = MyPgObject->new(id => 333, name => 'Zoom', flag => 1); $o->save; @o2s = ( MyPgOtherObject2->new(id => 5, name => 'five'), MyPgOtherObject2->new(id => 6, name => 'six'), MyPgOtherObject2->new(id => 7, name => 'seven'), ); $o->other2_objs_now(@o2s); # RESET $o = MyPgObject->new(id => 333, name => 'Zoom', flag => 1); # Add, no args @o2s = (); ok($o->add_other2_objs_now(@o2s) == 0, "add one to many now 1 - $db_type"); # Add before load/save @o2s = ( MyPgOtherObject2->new(id => 8, name => 'eight'), ); eval { $o->add_other2_objs_now(@o2s) }; ok($@, "add one to many now 2 - $db_type"); # Add $o->load; my @oret = $o->add_other2_objs_now(@o2s); is(scalar @oret, scalar @o2s && $oret[0] eq $o2s[0] && $oret[0]->isa('MyPgOtherObject2'), "add one to many now count - $db_type"); @o2s = $o->other2_objs; ok(@o2s == 4, "add one to many now 3 - $db_type"); ok($o2s[0]->id == 6 && $o2s[0]->pid == 333, "add one to many now 4 - $db_type"); ok($o2s[1]->id == 7 && $o2s[1]->pid == 333, "add one to many now 5 - $db_type"); ok($o2s[2]->id == 5 && $o2s[2]->pid == 333, "add one to many now 6 - $db_type"); ok($o2s[3]->id == 8 && $o2s[3]->pid == 333, "add one to many now 7 - $db_type"); ok(MyPgOtherObject2->new(id => 6)->load(speculative => 1), "add one to many now 8 - $db_type"); ok(MyPgOtherObject2->new(id => 7)->load(speculative => 1), "add one to many now 9 - $db_type"); ok(MyPgOtherObject2->new(id => 5)->load(speculative => 1), "add one to many now 10 - $db_type"); ok(MyPgOtherObject2->new(id => 8)->load(speculative => 1), "add one to many now 11 - $db_type"); # # "one to many" add_on_save # # SETUP $o2->db->dbh->do('DELETE FROM rose_db_object_other2'); $o = MyPgObject->new(id => 444, name => 'Blargh', flag => 1); # Set on save, add on save, save @o2s = ( MyPgOtherObject2->new(id => 10, name => 'ten'), ); # Set on save $o->other2_objs_on_save(@o2s); @o2s = $o->other2_objs; ok(@o2s == 1, "add one to many on save 1 - $db_type"); ok($o2s[0]->id == 10 && $o2s[0]->pid == 444, "add one to many on save 2 - $db_type"); ok(!MyPgOtherObject2->new(id => 10)->load(speculative => 1), "add one to many on save 3 - $db_type"); @o2s = ( MyPgOtherObject2->new(id => 9, name => 'nine'), ); # Add on save ok($o->add_other2_objs(@o2s), "add one to many on save 4 - $db_type"); @o2s = $o->other2_objs; ok(@o2s == 2, "add one to many on save 5 - $db_type"); ok($o2s[0]->id == 10 && $o2s[0]->pid == 444, "add one to many on save 6 - $db_type"); ok($o2s[1]->id == 9 && $o2s[0]->pid == 444, "add one to many on save 7 - $db_type"); ok(!MyPgOtherObject2->new(id => 10)->load(speculative => 1), "add one to many on save 8 - $db_type"); ok(!MyPgOtherObject2->new(id => 9)->load(speculative => 1), "add one to many on save 9 - $db_type"); $o->save; @o2s = $o->other2_objs; ok(@o2s == 2, "add one to many on save 10 - $db_type"); ok($o2s[0]->id == 10 && $o2s[0]->pid == 444, "add one to many on save 11 - $db_type"); ok($o2s[1]->id == 9 && $o2s[1]->pid == 444, "add one to many on save 12 - $db_type"); ok(MyPgOtherObject2->new(id => 10)->load(speculative => 1), "add one to many on save 13 - $db_type"); ok(MyPgOtherObject2->new(id => 9)->load(speculative => 1), "add one to many on save 14 - $db_type"); # RESET $o = MyPgObject->new(id => 444, name => 'Blargh', flag => 1); $o->load; # Add on save, save @o2s = ( MyPgOtherObject2->new(id => 11, name => 'eleven'), ); # Add on save ok($o->add_other2_objs(\@o2s), "add one to many on save 15 - $db_type"); @o2s = $o->other2_objs; ok(@o2s == 2, "add one to many on save 16 - $db_type"); ok($o2s[0]->id == 10 && $o2s[0]->pid == 444, "add one to many on save 17 - $db_type"); ok($o2s[1]->id == 9 && $o2s[1]->pid == 444, "add one to many on save 18 - $db_type"); ok(MyPgOtherObject2->new(id => 10)->load(speculative => 1), "add one to many on save 19 - $db_type"); ok(MyPgOtherObject2->new(id => 9)->load(speculative => 1), "add one to many on save 20 - $db_type"); ok(!MyPgOtherObject2->new(id => 11)->load(speculative => 1), "add one to many on save 21 - $db_type"); # Save $o->save; @o2s = $o->other2_objs; ok(@o2s == 3, "add one to many on save 22 - $db_type"); ok($o2s[0]->id == 10 && $o2s[0]->pid == 444, "add one to many on save 23 - $db_type"); ok($o2s[1]->id == 9 && $o2s[1]->pid == 444, "add one to many on save 24 - $db_type"); ok($o2s[2]->id == 11 && $o2s[2]->pid == 444, "add one to many on save 25 - $db_type"); ok(MyPgOtherObject2->new(id => 10)->load(speculative => 1), "add one to many on save 26 - $db_type"); ok(MyPgOtherObject2->new(id => 9)->load(speculative => 1), "add one to many on save 27 - $db_type"); ok(MyPgOtherObject2->new(id => 11)->load(speculative => 1), "add one to many on save 28 - $db_type"); # End "one to many" method tests # Start "load with ..." tests ok($o = MyPgObject->new(id => 444)->load(with => [ qw(other_obj other2_objs colors) ]), "load with 1 - $db_type"); ok($o->{'other2_objs'} && $o->{'other2_objs'}[1]->name eq 'nine', "load with 2 - $db_type"); $o = MyPgObject->new(id => 999); ok(!$o->load(with => [ qw(other_obj other2_objs colors) ], speculative => 1), "load with 3 - $db_type"); $o = MyPgObject->new(id => 222); ok($o->load(with => 'colors'), "load with 4 - $db_type"); # End "load with ..." tests # Start "many to many" tests # # "many to many" get_set_now # # SETUP $o = MyPgObject->new(id => 30, name => 'Color', flag => 1); # Set @colors = ( 1, # red MyPgColor->new(id => 3), # blue { id => 5, name => 'orange' }, ); #MyPgColor->new(id => 2), # green #MyPgColor->new(id => 4), # pink # Set before save, save, set eval { $o->colors_now(@colors) }; ok($@, "set many to many now 1 - $db_type"); $o->save; ok($o->colors_now(@colors), "set many to many now 2 - $db_type"); @colors = $o->colors_now; ok(@colors == 3, "set many to many now 3 - $db_type"); ok($colors[0]->id == 3, "set many to many now 4 - $db_type"); ok($colors[1]->id == 5, "set many to many now 5 - $db_type"); ok($colors[2]->id == 1, "set many to many now 6 - $db_type"); $color = MyPgColor->new(id => 5); ok($color->load(speculative => 1), "set many to many now 7 - $db_type"); ok(MyPgColorMap->new(obj_id => 30, color_id => 3)->load(speculative => 1), "set many to many now 8 - $db_type"); ok(MyPgColorMap->new(obj_id => 30, color_id => 5)->load(speculative => 1), "set many to many now 9 - $db_type"); ok(MyPgColorMap->new(obj_id => 30, color_id => 1)->load(speculative => 1), "set many to many now 10 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 30'); $sth->execute; $count = $sth->fetchrow_array; is($count, 3, "set many to many now 11 - $db_type"); # Set to undef $o->colors_now(undef); @colors = $o->colors_now; ok(@colors == 3, "set 2 many to many now 1 - $db_type"); ok($colors[0]->id == 3, "set 2 many to many now 2 - $db_type"); ok($colors[1]->id == 5, "set 2 many to many now 3 - $db_type"); ok($colors[2]->id == 1, "set 2 many to many now 4 - $db_type"); $color = MyPgColor->new(id => 5); ok($color->load(speculative => 1), "set 2 many to many now 5 - $db_type"); $color = MyPgColor->new(id => 3); ok($color->load(speculative => 1), "set 2 many to many now 6 - $db_type"); $color = MyPgColor->new(id => 1); ok($color->load(speculative => 1), "set 2 many to many now 7 - $db_type"); ok(MyPgColorMap->new(obj_id => 30, color_id => 3)->load(speculative => 1), "set 2 many to many now 8 - $db_type"); ok(MyPgColorMap->new(obj_id => 30, color_id => 5)->load(speculative => 1), "set 2 many to many now 9 - $db_type"); ok(MyPgColorMap->new(obj_id => 30, color_id => 1)->load(speculative => 1), "set 2 many to many now 10 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 30'); $sth->execute; $count = $sth->fetchrow_array; is($count, 3, "set 2 many to many now 11 - $db_type"); # # "many to many" get_set_on_save # # SETUP $o = MyPgObject->new(id => 40, name => 'Cool', flag => 1); # Set @colors = ( MyPgColor->new(id => 1), # red 3, # blue { id => 6, name => 'ochre' }, ); #MyPgColor->new(id => 2), # green #MyPgColor->new(id => 4), # pink $o->colors_on_save(@colors); @colors = $o->colors_on_save; ok(@colors == 3, "set many to many on save 1 - $db_type"); ok($colors[0]->id == 1, "set many to many on save 2 - $db_type"); ok($colors[1]->id == 3, "set many to many on save 3 - $db_type"); ok($colors[2]->id == 6, "set many to many on save 4 - $db_type"); ok(MyPgColor->new(id => 1)->load(speculative => 1), "set many to many on save 5 - $db_type"); ok(MyPgColor->new(id => 3)->load(speculative => 1), "set many to many on save 6 - $db_type"); ok(!MyPgColor->new(id => 6)->load(speculative => 1), "set many to many on save 7 - $db_type"); ok(!MyPgColorMap->new(obj_id => 40, color_id => 1)->load(speculative => 1), "set many to many on save 8 - $db_type"); ok(!MyPgColorMap->new(obj_id => 40, color_id => 3)->load(speculative => 1), "set many to many on save 9 - $db_type"); ok(!MyPgColorMap->new(obj_id => 40, color_id => 6)->load(speculative => 1), "set many to many on save 10 - $db_type"); $o->save; @colors = $o->colors_on_save; ok(@colors == 3, "set many to many on save 11 - $db_type"); ok($colors[0]->id == 3, "set many to many on save 12 - $db_type"); ok($colors[1]->id == 6, "set many to many on save 13 - $db_type"); ok($colors[2]->id == 1, "set many to many on save 14 - $db_type"); ok(MyPgColor->new(id => 1)->load(speculative => 1), "set many to many on save 15 - $db_type"); ok(MyPgColor->new(id => 3)->load(speculative => 1), "set many to many on save 16 - $db_type"); ok(MyPgColor->new(id => 6)->load(speculative => 1), "set many to many on save 17 - $db_type"); ok(MyPgColorMap->new(obj_id => 40, color_id => 1)->load(speculative => 1), "set 2 many to many on save 18 - $db_type"); ok(MyPgColorMap->new(obj_id => 40, color_id => 3)->load(speculative => 1), "set 2 many to many on save 19 - $db_type"); ok(MyPgColorMap->new(obj_id => 40, color_id => 6)->load(speculative => 1), "set 2 many to many on save 20 - $db_type"); $sth = $color->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 40'); $sth->execute; $count = $sth->fetchrow_array; is($count, 3, "set many to many on save 21 - $db_type"); # RESET $o = MyPgObject->new(id => 40)->load; # Set to undef $o->colors_on_save(undef); @colors = $o->colors_on_save; ok(@colors == 3, "set 2 many to many on save 1 - $db_type"); ok($colors[0]->id == 3, "set 2 many to many on save 2 - $db_type"); ok($colors[1]->id == 6, "set 2 many to many on save 3 - $db_type"); ok($colors[2]->id == 1, "set 2 many to many on save 4 - $db_type"); ok(MyPgColor->new(id => 1)->load(speculative => 1), "set 2 many to many on save 5 - $db_type"); ok(MyPgColor->new(id => 3)->load(speculative => 1), "set 2 many to many on save 6 - $db_type"); ok(MyPgColor->new(id => 6)->load(speculative => 1), "set 2 many to many on save 7 - $db_type"); ok(MyPgColorMap->new(obj_id => 40, color_id => 1)->load(speculative => 1), "set 2 many to many on save 8 - $db_type"); ok(MyPgColorMap->new(obj_id => 40, color_id => 3)->load(speculative => 1), "set 2 many to many on save 9 - $db_type"); ok(MyPgColorMap->new(obj_id => 40, color_id => 6)->load(speculative => 1), "set 2 many to many on save 10 - $db_type"); $sth = $color->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 40'); $sth->execute; $count = $sth->fetchrow_array; is($count, 3, "set 2 many to many on save 11 - $db_type"); # Tests for SQL efficiency of __check_and_merge # $DB::single = 1; # $o->save(changes_only => 1); # $o->colors_on_save({ id => 2 }); # $Rose::DB::Object::Manager::Debug = 1; # $Rose::DB::Object::Debug = 1; # $o->save(changes_only => 1); # exit; $o->colors([]); $o->save(changes_only => 1); $o->colors_on_save({ id => 1, name => 'redx' }, { id => 3 }); $o->save(changes_only => 1); $o->colors_on_save(undef); $colors = $o->colors_on_save; ok(ref $colors eq 'ARRAY' && @$colors == 2 && $colors->[0]->name eq 'blue' && $colors->[1]->name eq 'redx', "colors merge 1 - $db_type"); $o->colors_on_save({ id => 2 }, { id => 3, name => 'bluex' }); $o->save(changes_only => 1); $o->colors_on_save(undef); $colors = $o->colors_on_save; ok(ref $colors eq 'ARRAY' && @$colors == 2 && $colors->[0]->name eq 'bluex' && $colors->[1]->name eq 'green', "colors merge 2 - $db_type"); # # "many to many" add_now # # SETUP $o = MyPgObject->new(id => 50, name => 'Blat', flag => 1); $o->delete; @colors = ( MyPgColor->new(id => 1), # red MyPgColor->new(id => 3), # blue ); #MyPgColor->new(id => 4), # pink $o->colors_on_save(\@colors); $o->save; $o = MyPgObject->new(id => 50, name => 'Blat', flag => 1); # Add, no args @colors = (); ok($o->add_colors(@colors) == 0, "add many to many now 1 - $db_type"); # Add before load/save @colors = ( MyPgColor->new(id => 7, name => 'puce'), MyPgColor->new(id => 2), # green ); eval { $o->add_colors(@colors) }; ok($@, "add many to many now 2 - $db_type"); # Add $o->load; $o->add_colors(@colors); @colors = $o->colors; ok(@colors == 4, "add many to many now 3 - $db_type"); ok($colors[0]->id == 3, "add many to many now 4 - $db_type"); ok($colors[1]->id == 2, "add many to many now 5 - $db_type"); ok($colors[2]->id == 7, "add many to many now 6 - $db_type"); ok($colors[3]->id == 1, "add many to many now 7 - $db_type"); ok(MyPgColor->new(id => 3)->load(speculative => 1), "add many to many now 8 - $db_type"); ok(MyPgColor->new(id => 2)->load(speculative => 1), "add many to many now 9 - $db_type"); ok(MyPgColor->new(id => 7)->load(speculative => 1), "add many to many now 10 - $db_type"); ok(MyPgColor->new(id => 1)->load(speculative => 1), "add many to many now 11 - $db_type"); ok(MyPgColorMap->new(obj_id => 50, color_id => 3)->load(speculative => 1), "set 2 many to many on save 12 - $db_type"); ok(MyPgColorMap->new(obj_id => 50, color_id => 2)->load(speculative => 1), "set 2 many to many on save 13 - $db_type"); ok(MyPgColorMap->new(obj_id => 50, color_id => 7)->load(speculative => 1), "set 2 many to many on save 14 - $db_type"); ok(MyPgColorMap->new(obj_id => 50, color_id => 1)->load(speculative => 1), "set 2 many to many on save 15 - $db_type"); # # "many to many" add_on_save # # SETUP $o = MyPgObject->new(id => 60, name => 'Cretch', flag => 1); $o->delete; # Set on save, add on save, save @colors = ( MyPgColor->new(id => 1), # red MyPgColor->new(id => 2), # green ); # Set on save $o->colors_on_save(@colors); @colors = ( MyPgColor->new(id => 7), # puce MyPgColor->new(id => 8, name => 'tan'), ); # Add on save my $num = $o->add_colors_on_save(@colors); is($num, scalar @colors, "add many to many on save 1 - $db_type"); @colors = $o->colors; ok(@colors == 4, "add many to many on save 2 - $db_type"); ok($colors[0]->id == 1, "add many to many on save 3 - $db_type"); ok($colors[1]->id == 2, "add many to many on save 4 - $db_type"); ok($colors[2]->id == 7, "add many to many on save 5 - $db_type"); ok($colors[3]->id == 8, "add many to many on save 6 - $db_type"); ok(MyPgColor->new(id => 1)->load(speculative => 1), "add many to many on save 7 - $db_type"); ok(MyPgColor->new(id => 2)->load(speculative => 1), "add many to many on save 8 - $db_type"); ok(MyPgColor->new(id => 7)->load(speculative => 1), "add many to many on save 9 - $db_type"); ok(!MyPgColor->new(id => 8)->load(speculative => 1), "add many to many on save 10 - $db_type"); ok(!MyPgColorMap->new(obj_id => 60, color_id => 1)->load(speculative => 1), "set many to many on save 11 - $db_type"); ok(!MyPgColorMap->new(obj_id => 60, color_id => 2)->load(speculative => 1), "set many to many on save 12 - $db_type"); ok(!MyPgColorMap->new(obj_id => 60, color_id => 7)->load(speculative => 1), "set many to many on save 13 - $db_type"); ok(!MyPgColorMap->new(obj_id => 60, color_id => 8)->load(speculative => 1), "set many to many on save 14 - $db_type"); $o->save; @colors = $o->colors; ok(@colors == 4, "add many to many on save 15 - $db_type"); ok($colors[0]->id == 2, "add many to many on save 16 - $db_type"); ok($colors[1]->id == 7, "add many to many on save 17 - $db_type"); ok($colors[2]->id == 1, "add many to many on save 18 - $db_type"); ok($colors[3]->id == 8, "add many to many on save 19 - $db_type"); ok(MyPgColor->new(id => 2)->load(speculative => 1), "add many to many on save 20 - $db_type"); ok(MyPgColor->new(id => 7)->load(speculative => 1), "add many to many on save 21 - $db_type"); ok(MyPgColor->new(id => 1)->load(speculative => 1), "add many to many on save 22 - $db_type"); ok(MyPgColor->new(id => 8)->load(speculative => 1), "add many to many on save 21 - $db_type"); ok(MyPgColorMap->new(obj_id => 60, color_id => 2)->load(speculative => 1), "add many to many on save 22 - $db_type"); ok(MyPgColorMap->new(obj_id => 60, color_id => 7)->load(speculative => 1), "add many to many on save 23 - $db_type"); ok(MyPgColorMap->new(obj_id => 60, color_id => 1)->load(speculative => 1), "add many to many on save 24 - $db_type"); ok(MyPgColorMap->new(obj_id => 60, color_id => 8)->load(speculative => 1), "add many to many on save 25 - $db_type"); $sth = $color->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 60'); $sth->execute; $count = $sth->fetchrow_array; is($count, 4, "add many to many on save 26 - $db_type"); # RESET $o = MyPgObject->new(id => 60, name => 'Cretch', flag => 1); $o->load(with => 'colors'); # Add on save, save @colors = ( MyPgColor->new(id => 9, name => 'aqua'), ); # Add on save ok($o->add_colors_on_save(@colors), "add 2 many to many on save 1 - $db_type"); @colors = $o->colors; ok(@colors == 5, "add 2 many to many on save 16 - $db_type"); ok($colors[0]->id == 2, "add 2 many to many on save 2 - $db_type"); ok($colors[1]->id == 7, "add 2 many to many on save 3 - $db_type"); ok($colors[2]->id == 1, "add 2 many to many on save 4 - $db_type"); ok($colors[3]->id == 8, "add 2 many to many on save 5 - $db_type"); ok($colors[4]->id == 9, "add 2 many to many on save 6 - $db_type"); ok(MyPgColor->new(id => 2)->load(speculative => 1), "add many to many on save 7 - $db_type"); ok(MyPgColor->new(id => 7)->load(speculative => 1), "add many to many on save 8 - $db_type"); ok(MyPgColor->new(id => 1)->load(speculative => 1), "add many to many on save 9 - $db_type"); ok(MyPgColor->new(id => 8)->load(speculative => 1), "add many to many on save 10 - $db_type"); ok(!MyPgColor->new(id => 9)->load(speculative => 1), "add many to many on save 11 - $db_type"); ok(MyPgColorMap->new(obj_id => 60, color_id => 2)->load(speculative => 1), "add 2 many to many on save 12 - $db_type"); ok(MyPgColorMap->new(obj_id => 60, color_id => 7)->load(speculative => 1), "add 2 many to many on save 13 - $db_type"); ok(MyPgColorMap->new(obj_id => 60, color_id => 1)->load(speculative => 1), "add 2 many to many on save 14 - $db_type"); ok(MyPgColorMap->new(obj_id => 60, color_id => 8)->load(speculative => 1), "add 2 many to many on save 15 - $db_type"); ok(!MyPgColorMap->new(obj_id => 60, color_id => 9)->load(speculative => 1), "add 2 many to many on save 16 - $db_type"); $sth = $color->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 60'); $sth->execute; $count = $sth->fetchrow_array; is($count, 4, "add 2 many to many on save 17 - $db_type"); # Save $o->save; @colors = $o->colors; ok(@colors == 5, "add 2 many to many on save 18 - $db_type"); ok($colors[0]->id == 9, "add 2 many to many on save 19 - $db_type"); ok($colors[1]->id == 2, "add 2 many to many on save 20 - $db_type"); ok($colors[2]->id == 7, "add 2 many to many on save 21 - $db_type"); ok($colors[3]->id == 1, "add 2 many to many on save 22 - $db_type"); ok($colors[4]->id == 8, "add 2 many to many on save 23 - $db_type"); ok(MyPgColor->new(id => 9)->load(speculative => 1), "add many to many on save 24 - $db_type"); ok(MyPgColor->new(id => 2)->load(speculative => 1), "add many to many on save 25 - $db_type"); ok(MyPgColor->new(id => 7)->load(speculative => 1), "add many to many on save 26 - $db_type"); ok(MyPgColor->new(id => 1)->load(speculative => 1), "add many to many on save 27 - $db_type"); ok(MyPgColor->new(id => 8)->load(speculative => 1), "add many to many on save 28 - $db_type"); ok(MyPgColorMap->new(obj_id => 60, color_id => 9)->load(speculative => 1), "add 2 many to many on save 29 - $db_type"); ok(MyPgColorMap->new(obj_id => 60, color_id => 2)->load(speculative => 1), "add 2 many to many on save 20 - $db_type"); ok(MyPgColorMap->new(obj_id => 60, color_id => 7)->load(speculative => 1), "add 2 many to many on save 31 - $db_type"); ok(MyPgColorMap->new(obj_id => 60, color_id => 1)->load(speculative => 1), "add 2 many to many on save 32 - $db_type"); ok(MyPgColorMap->new(obj_id => 60, color_id => 8)->load(speculative => 1), "add 2 many to many on save 33 - $db_type"); $sth = $color->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 60'); $sth->execute; $count = $sth->fetchrow_array; is($count, 5, "add 2 many to many on save 34 - $db_type"); # End "many to many" tests test_meta(MyPgOtherObject2->meta, 'MyPg', $db_type); } # # MySQL # SKIP: foreach my $db_type ('mysql') { skip("MySQL tests", 359) unless($HAVE_MYSQL); Rose::DB->default_type($db_type); my $o = MyMySQLObject->new(name => 'John'); ok(ref $o && $o->isa('MyMySQLObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(22); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); my $o_x = MyMySQLObject->new(id => 99, name => 'John X', flag => 0); $o_x->save; my $o2 = MyMySQLObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyMySQLObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 22, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyMySQLObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyMySQLObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); my $oo21 = MyMySQLOtherObject2->new(id => 1, name => 'one', pid => $o->id); ok($oo21->save, "other object 2 save() 1 - $db_type"); my $oo22 = MyMySQLOtherObject2->new(id => 2, name => 'two', pid => $o->id); ok($oo22->save, "other object 2 save() 2 - $db_type"); my $oo23 = MyMySQLOtherObject2->new(id => 3, name => 'three', pid => $o_x->id); ok($oo23->save, "other object 2 save() 3 - $db_type"); # Begin filtered collection tests my $x = MyMySQLObject->new(id => $o->id)->load; $x->other2_a_objs({ name => 'aoo' }, { name => 'abc' }); $x->save; $x = MyMySQLObject->new(id => $o->id)->load; my $ao = $x->other2_a_objs; my $oo = $x->other2_objs; is(scalar @$ao, 2, "filtered one-to-many 1 - $db_type"); is(join(',', map { $_->name } @$ao), 'abc,aoo', "filtered one-to-many 2 - $db_type"); is(scalar @$oo, 4, "filtered one-to-many 3 - $db_type"); is(join(',', sort map { $_->name } @$oo), 'abc,aoo,one,two', "filtered one-to-many 4 - $db_type"); $x->other2_a_objs({ name => 'axx' }); $x->save; $x = MyMySQLObject->new(id => $o->id)->load; $ao = $x->other2_a_objs; $oo = $x->other2_objs; is(scalar @$ao, 1, "filtered one-to-many 5 - $db_type"); is(join(',', map { $_->name } @$ao), 'axx', "filtered one-to-many 6 - $db_type"); is(scalar @$oo, 3, "filtered one-to-many 7 - $db_type"); is(join(',', sort map { $_->name } @$oo), 'axx,one,two', "filtered one-to-many 8 - $db_type"); $x->other2_a_objs([]); $x->save; # End filtered collection tests ok(!$o->has_loaded_related('other2_objs'), "has_loaded_related() 1 - $db_type"); my $o2s = $o->other2_objs; ok($o->has_loaded_related('other2_objs'), "has_loaded_related() 2 - $db_type"); ok(ref $o2s eq 'ARRAY' && @$o2s == 2 && $o2s->[0]->name eq 'two' && $o2s->[1]->name eq 'one', 'other objects 1'); my @o2s = $o->other2_objs; ok(@o2s == 2 && $o2s[0]->name eq 'two' && $o2s[1]->name eq 'one', 'other objects 2'); my $color = MyMySQLColor->new(id => 1, name => 'red'); ok($color->save, "save color 1 - $db_type"); $color = MyMySQLColor->new(id => 2, name => 'green'); ok($color->save, "save color 2 - $db_type"); $color = MyMySQLColor->new(id => 3, name => 'blue'); ok($color->save, "save color 3 - $db_type"); $color = MyMySQLColor->new(id => 4, name => 'pink'); ok($color->save, "save color 4 - $db_type"); my $map1 = MyMySQLColorMap->new(obj_id => 1, color_id => 1); ok($map1->save, "save color map record 1 - $db_type"); my $map2 = MyMySQLColorMap->new(obj_id => 1, color_id => 3); ok($map2->save, "save color map record 2 - $db_type"); my $map3 = MyMySQLColorMap->new(obj_id => 99, color_id => 4); ok($map3->save, "save color map record 3 - $db_type"); my $colors = $o->colors; ok(ref $colors eq 'ARRAY' && @$colors == 2 && $colors->[0]->name eq 'blue' && $colors->[1]->name eq 'red', "colors 1 - $db_type"); $colors = $o->find_colors; ok(ref $colors eq 'ARRAY' && @$colors == 2 && $colors->[0]->name eq 'blue' && $colors->[1]->name eq 'red', "find colors 1 - $db_type"); $colors = $o->find_colors([ name => { like => 'r%' } ]); ok(ref $colors eq 'ARRAY' && @$colors == 1 && $colors->[0]->name eq 'red', "find colors 2 - $db_type"); $colors = $o->find_colors(query => [ name => { like => 'r%' } ], cache => 1); my $colors2 = $o->find_colors(from_cache => 1); ok(ref $colors eq 'ARRAY' && @$colors == 1 && $colors->[0]->name eq 'red' && ref $colors2 eq 'ARRAY' && @$colors2 == 1 && $colors2->[0]->name eq 'red' && $colors->[0] eq $colors2->[0], "find colors from cache - $db_type"); my $count = $o->colors_count; is($count, 2, "count colors 1 - $db_type"); $count = $o->colors_count([ name => { like => 'r%' } ]); is($count, 1, "count colors 2 - $db_type"); my @colors = $o->colors; ok(@colors == 2 && $colors[0]->name eq 'blue' && $colors[1]->name eq 'red', "colors 2 - $db_type"); $colors = $o_x->colors; ok(ref $colors eq 'ARRAY' && @$colors == 1 && $colors->[0]->name eq 'pink', "colors 3 - $db_type"); @colors = $o_x->colors; ok(@colors == 1 && $colors[0]->name eq 'pink', "colors 4 - $db_type"); $o = MyMySQLObject->new(id => 1)->load; $o->fk1(99); $o->fk2(99); $o->fk3(99); eval { $o->other_obj }; ok($@, "fatal referential_integrity - $db_type"); ok(!defined $o->other_obj_osoft, "ok referential_integrity 1 - $db_type"); ok(!defined $o->other_obj_msoft, "ok referential_integrity 2 - $db_type"); $o->fk1(1); $o->fk2(2); $o->fk3(3); $o->save; #local $Rose::DB::Object::Manager::Debug = 1; my $ret; eval { local $o->dbh->{'PrintError'} = 0; $ret = $o->delete(cascade => 'null'); }; # Allow for exceptions in case some fancy new version of MySQL actually # tries preserve referential integrity. Hey, you never know... ok($ret || $@, "delete cascade null 1 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( db => $o->db, object_class => 'MyMySQLOtherObject2'); is($count, 3, "delete cascade rollback confirm 2 - $db_type"); $o = MyMySQLObject->new(id => 99)->load; $o->fk1(11); $o->fk2(12); $o->fk3(13); $o->save; eval { local $o->dbh->{'PrintError'} = 0; $ret = $o->delete(cascade => 'null'); }; ok($ret || $@, "delete cascade null 2 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( db => $o->db, object_class => 'MyMySQLColorMap'); is($count, 3, "delete cascade confirm 1 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( db => $o->db, object_class => 'MyMySQLOtherObject2'); is($count, 3, "delete cascade confirm 2 - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, "alias_column() nonesuch - $db_type"); # Start foreign key method tests # # Foreign key get_set_now # $o = MyMySQLObject->new(id => 50, name => 'Alex', flag => 1); eval { $o->other_obj('abc') }; ok($@, "set foreign key object: one arg - $db_type"); eval { $o->other_obj(k1 => 1, k2 => 2, k3 => 3) }; ok($@, "set foreign key object: no save - $db_type"); $o->save; eval { local $o->db->dbh->{'PrintError'} = 0; $o->other_obj(k1 => 1, k2 => 2); }; ok($@, "set foreign key object: too few keys - $db_type"); ok($o->other_obj(k1 => 1, k2 => 2, k3 => 3), "set foreign key object 1 - $db_type"); ok($o->fk1 == 1 && $o->fk2 == 2 && $o->fk3 == 3, "set foreign key object check keys 1 - $db_type"); ok($o->other_obj(k1 => 1, k2 => 2, k3 => 3), "set foreign key object 2 - $db_type"); ok($o->fk1 == 1 && $o->fk2 == 2 && $o->fk3 == 3, "set foreign key object check keys 2 - $db_type"); # # Foreign key delete_now # ok($o->delete_other_obj, "delete foreign key object 1 - $db_type"); ok(!defined $o->fk1 && !defined $o->fk2 && !defined $o->fk3, "delete foreign key object check keys 1 - $db_type"); ok(!defined $o->other_obj && defined $o->error, "delete foreign key object confirm 1 - $db_type"); ok(!defined $o->delete_other_obj, "delete foreign key object 2 - $db_type"); # # Foreign key get_set_on_save # # TEST: Set, save $o = MyMySQLObject->new(id => 100, name => 'Bub', flag => 1); ok($o->other_obj_on_save(k1 => 21, k2 => 22, k3 => 23), "set foreign key object on save 1 - $db_type"); my $co = MyMySQLObject->new(id => 100); ok(!$co->load(speculative => 1), "set foreign key object on save 2 - $db_type"); my $other_obj = $o->other_obj_on_save; ok($other_obj && $other_obj->k1 == 21 && $other_obj->k2 == 22 && $other_obj->k3 == 23, "set foreign key object on save 3 - $db_type"); ok($o->save, "set foreign key object on save 4 - $db_type"); $o = MyMySQLObject->new(id => 100); $o->load; $other_obj = $o->other_obj_on_save; ok($other_obj && $other_obj && $other_obj->k1 == 21 && $other_obj->k2 == 22 && $other_obj->k3 == 23, "set foreign key object on save 5 - $db_type"); # TEST: Set, set to undef, save $o = MyMySQLObject->new(id => 200, name => 'Rose', flag => 1); ok($o->other_obj_on_save(k1 => 51, k2 => 52, k3 => 53), "set foreign key object on save 6 - $db_type"); $co = MyMySQLObject->new(id => 200); ok(!$co->load(speculative => 1), "set foreign key object on save 7 - $db_type"); $other_obj = $o->other_obj_on_save; ok($other_obj && $other_obj->k1 == 51 && $other_obj->k2 == 52 && $other_obj->k3 == 53, "set foreign key object on save 8 - $db_type"); $o->other_obj_on_save(undef); ok($o->save, "set foreign key object on save 9 - $db_type"); $o = MyMySQLObject->new(id => 200); $o->load; ok(!defined $o->other_obj_on_save, "set foreign key object on save 10 - $db_type"); $co = MyMySQLOtherObject->new(k1 => 51, k2 => 52, k3 => 53); ok(!$co->load(speculative => 1), "set foreign key object on save 11 - $db_type"); $o->delete(cascade => 1); # TEST: Set, delete, save $o = MyMySQLObject->new(id => 200, name => 'Rose', flag => 1); ok($o->other_obj_on_save(k1 => 51, k2 => 52, k3 => 53), "set foreign key object on save 12 - $db_type"); $co = MyMySQLObject->new(id => 200); ok(!$co->load(speculative => 1), "set foreign key object on save 13 - $db_type"); $other_obj = $o->other_obj_on_save; ok($other_obj && $other_obj->k1 == 51 && $other_obj->k2 == 52 && $other_obj->k3 == 53, "set foreign key object on save 14 - $db_type"); ok($o->delete_other_obj, "set foreign key object on save 15 - $db_type"); $other_obj = $o->other_obj_on_save; ok(!defined $other_obj && !defined $o->fk1 && !defined $o->fk2 && !defined $o->fk3, "set foreign key object on save 16 - $db_type"); ok($o->save, "set foreign key object on save 17 - $db_type"); $o = MyMySQLObject->new(id => 200); $o->load; ok(!defined $o->other_obj_on_save, "set foreign key object on save 18 - $db_type"); $co = MyMySQLOtherObject->new(k1 => 51, k2 => 52, k3 => 53); ok(!$co->load(speculative => 1), "set foreign key object on save 19 - $db_type"); $o->delete(cascade => 1); # # Foreign key delete_on_save # $o = MyMySQLObject->new(id => 500, name => 'Kip', flag => 1); $o->other_obj_on_save(k1 => 7, k2 => 8, k3 => 9); $o->save; $o = MyMySQLObject->new(id => 500); $o->load; # TEST: Delete, save $o->del_other_obj_on_save; $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are undef... ok(!defined $other_obj && !defined $o->fk1 && !defined $o->fk2 && !defined $o->fk3, "delete foreign key object on save 1 - $db_type"); # ...but that the foreign object has not yet been deleted $co = MyMySQLOtherObject->new(k1 => 7, k2 => 8, k3 => 9); ok($co->load(speculative => 1), "delete foreign key object on save 2 - $db_type"); # Do the save ok($o->save, "delete foreign key object on save 3 - $db_type"); # Now it's deleted $co = MyMySQLOtherObject->new(k1 => 7, k2 => 8, k3 => 9); ok(!$co->load(speculative => 1), "delete foreign key object on save 4 - $db_type"); $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are undef ok(!defined $other_obj && !defined $o->fk1 && !defined $o->fk2 && !defined $o->fk3, "delete foreign key object on save 5 - $db_type"); # RESET $o->delete; $o = MyMySQLObject->new(id => 700, name => 'Ham', flag => 0); $o->other_obj_on_save(k1 => 12, k2 => 34, k3 => 56); $o->save; $o = MyMySQLObject->new(id => 700); $o->load; # TEST: Delete, set on save, delete, save ok($o->del_other_obj_on_save, "delete 2 foreign key object on save 1 - $db_type"); $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are undef... ok(!defined $other_obj && !defined $o->fk1 && !defined $o->fk2 && !defined $o->fk3, "delete 2 foreign key object on save 2 - $db_type"); # ...but that the foreign object has not yet been deleted $co = MyMySQLOtherObject->new(k1 => 12, k2 => 34, k3 => 56); ok($co->load(speculative => 1), "delete 3 foreign key object on save 3 - $db_type"); # Set on save $o->other_obj_on_save(k1 => 44, k2 => 55, k3 => 66); $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are set... ok($other_obj && $other_obj->k1 == 44 && $other_obj->k2 == 55 && $other_obj->k3 == 66, "delete 2 foreign key object on save 4 - $db_type"); # ...and that the foreign object has not yet been saved $co = MyMySQLOtherObject->new(k1 => 44, k2 => 55, k3 => 66); ok(!$co->load(speculative => 1), "delete 2 foreign key object on save 5 - $db_type"); # Delete again ok($o->del_other_obj_on_save, "delete 2 foreign key object on save 6 - $db_type"); $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are undef... ok(!defined $other_obj && !defined $o->fk1 && !defined $o->fk2 && !defined $o->fk3, "delete 2 foreign key object on save 7 - $db_type"); # Confirm that the foreign objects have not been saved $co = MyMySQLOtherObject->new(k1 => 7, k2 => 8, k3 => 9); ok(!$co->load(speculative => 1), "delete 2 foreign key object on save 8 - $db_type"); $co = MyMySQLOtherObject->new(k1 => 44, k2 => 55, k3 => 66); ok(!$co->load(speculative => 1), "delete 2 foreign key object on save 9 - $db_type"); # RESET $o->delete; $o = MyMySQLObject->new(id => 800, name => 'Lee', flag => 1); $o->other_obj_on_save(k1 => 12, k2 => 34, k3 => 56); $o->save; $o = MyMySQLObject->new(id => 800); $o->load; # TEST: Set & save, delete on save, set on save, delete on save, save ok($o->other_obj(k1 => 1, k2 => 2, k3 => 3), "delete 3 foreign key object on save 1 - $db_type"); # Confirm that both foreign objects are in the db $co = MyMySQLOtherObject->new(k1 => 12, k2 => 34, k3 => 56); ok($co->load(speculative => 1), "delete 3 foreign key object on save 2 - $db_type"); $co = MyMySQLOtherObject->new(k1 => 1, k2 => 2, k3 => 3); ok($co->load(speculative => 1), "delete 3 foreign key object on save 3 - $db_type"); # Delete on save $o->del_other_obj_on_save; # Set-on-save to old value $o->other_obj_on_save(k1 => 12, k2 => 34, k3 => 56); # Delete on save $o->del_other_obj_on_save; # Save $o->save; # Confirm that both foreign objects have been deleted $co = MyMySQLOtherObject->new(k1 => 12, k2 => 34, k3 => 56); ok(!$co->load(speculative => 1), "delete 3 foreign key object on save 4 - $db_type"); $co = MyMySQLOtherObject->new(k1 => 1, k2 => 2, k3 => 3); ok(!$co->load(speculative => 1), "delete 3 foreign key object on save 5 - $db_type"); # RESET $o->delete; $o = MyMySQLObject->new(id => 900, name => 'Kai', flag => 1); $o->other_obj_on_save(k1 => 12, k2 => 34, k3 => 56); $o->save; $o = MyMySQLObject->new(id => 900); $o->load; # TEST: Delete on save, set on save, delete on save, set to same one, save $o->del_other_obj_on_save; # Set on save ok($o->other_obj_on_save(k1 => 1, k2 => 2, k3 => 3), "delete 4 foreign key object on save 1 - $db_type"); # Delete on save $o->del_other_obj_on_save; # Set-on-save to previous value $o->other_obj_on_save(k1 => 1, k2 => 2, k3 => 3); # Save $o->save; $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are set... ok($other_obj && $other_obj->k1 == 1 && $other_obj->k2 == 2 && $other_obj->k3 == 3, "delete 4 foreign key object on save 2 - $db_type"); # Confirm that the new foreign object is there and the old one is not $co = MyMySQLOtherObject->new(k1 => 1, k2 => 2, k3 => 3); ok($co->load(speculative => 1), "delete 4 foreign key object on save 3 - $db_type"); $co = MyMySQLOtherObject->new(k1 => 12, k2 => 34, k3 => 56); ok(!$co->load(speculative => 1), "delete 4 foreign key object on save 4 - $db_type"); # End foreign key method tests # Start "one to many" method tests # # "one to many" get_set_now # # SETUP $o = MyMySQLObject->new(id => 111, name => 'Boo', flag => 1); @o2s = ( 1, MyMySQLOtherObject2->new(id => 2, name => 'two'), { id => 3, name => 'three' }, ); # Set before save, save, set eval { $o->other2_objs_now(@o2s) }; ok($@, "set one to many now 1 - $db_type"); $o->save; ok($o->other2_objs_now(@o2s), "set one to many now 2 - $db_type"); @o2s = $o->other2_objs_now; ok(@o2s == 3, "set one to many now 3 - $db_type"); ok($o2s[0]->id == 2 && $o2s[0]->pid == 111, "set one to many now 4 - $db_type"); ok($o2s[1]->id == 3 && $o2s[1]->pid == 111, "set one to many now 5 - $db_type"); ok($o2s[2]->id == 1 && $o2s[2]->pid == 111, "set one to many now 6 - $db_type"); $o2 = MyMySQLOtherObject2->new(id => 1)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 7 - $db_type"); $o2 = MyMySQLOtherObject2->new(id => 2)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 8 - $db_type"); $o2 = MyMySQLOtherObject2->new(id => 3)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 9 - $db_type"); my $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_other2 WHERE pid = 111'); $sth->execute; $count = $sth->fetchrow_array; is($count, 3, "set one to many now 10 - $db_type"); # Set to undef $o->other2_objs_now(undef); @o2s = $o->other2_objs_now; ok(@o2s == 3, "set one to many now 11 - $db_type"); ok($o2s[0]->id == 2 && $o2s[0]->pid == 111, "set one to many now 12 - $db_type"); ok($o2s[1]->id == 3 && $o2s[1]->pid == 111, "set one to many now 13 - $db_type"); ok($o2s[2]->id == 1 && $o2s[2]->pid == 111, "set one to many now 14 - $db_type"); $o2 = MyMySQLOtherObject2->new(id => 1)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 15 - $db_type"); $o2 = MyMySQLOtherObject2->new(id => 2)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 16 - $db_type"); $o2 = MyMySQLOtherObject2->new(id => 3)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 17 - $db_type"); # RESET $o = MyMySQLObject->new(id => 111)->load; # Set (one existing, one new) @o2s = ( MyMySQLOtherObject2->new(id => 1, name => 'one'), MyMySQLOtherObject2->new(id => 7, name => 'seven'), ); ok($o->other2_objs_now(\@o2s), "set 2 one to many now 1 - $db_type"); $o2 = MyMySQLOtherObject2->new(id => 1)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many now 2 - $db_type"); $o2 = MyMySQLOtherObject2->new(id => 7)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many now 3 - $db_type"); @o2s = $o->other2_objs_now; ok(@o2s == 2, "set 2 one to many now 4 - $db_type"); ok($o2s[0]->id == 7 && $o2s[0]->pid == 111, "set 2 one to many now 5 - $db_type"); ok($o2s[1]->id == 1 && $o2s[1]->pid == 111, "set 2 one to many now 6 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_other2 WHERE pid = 111'); $sth->execute; $count = $sth->fetchrow_array; is($count, 2, "set 2 one to many now 7 - $db_type"); # # "one to many" get_set_on_save # # SETUP $o2->db->dbh->do('DELETE FROM rose_db_object_other2'); $o = MyMySQLObject->new(id => 222, name => 'Hap', flag => 1); @o2s = ( MyMySQLOtherObject2->new(id => 5, name => 'five'), MyMySQLOtherObject2->new(id => 6, name => 'six'), MyMySQLOtherObject2->new(id => 7, name => 'seven'), ); $o->other2_objs_on_save(@o2s); @o2s = $o->other2_objs_on_save; ok(@o2s == 3, "set one to many on save 1 - $db_type"); ok($o2s[0]->id == 5 && $o2s[0]->pid == 222, "set one to many on save 2 - $db_type"); ok($o2s[1]->id == 6 && $o2s[1]->pid == 222, "set one to many on save 3 - $db_type"); ok($o2s[2]->id == 7 && $o2s[2]->pid == 222, "set one to many on save 4 - $db_type"); ok(!MyMySQLOtherObject2->new(id => 5)->load(speculative => 1), "set one to many on save 5 - $db_type"); ok(!MyMySQLOtherObject2->new(id => 6)->load(speculative => 1), "set one to many on save 6 - $db_type"); ok(!MyMySQLOtherObject2->new(id => 7)->load(speculative => 1), "set one to many on save 7 - $db_type"); $o->save; @o2s = $o->other2_objs_on_save; ok(@o2s == 3, "set one to many on save 8 - $db_type"); ok($o2s[0]->id == 6 && $o2s[0]->pid == 222, "set one to many on save 9 - $db_type"); ok($o2s[1]->id == 7 && $o2s[1]->pid == 222, "set one to many on save 10 - $db_type"); ok($o2s[2]->id == 5 && $o2s[2]->pid == 222, "set one to many on save 11 - $db_type"); $o2 = MyMySQLOtherObject2->new(id => 5)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many on save 12 - $db_type"); $o2 = MyMySQLOtherObject2->new(id => 6)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many on save 13 - $db_type"); $o2 = MyMySQLOtherObject2->new(id => 7)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many on save 14 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_other2 WHERE pid = 222'); $sth->execute; $count = $sth->fetchrow_array; is($count, 3, "set one to many on save 15 - $db_type"); # RESET $o = MyMySQLObject->new(id => 222)->load; # Set (one existing, one new) @o2s = ( MyMySQLOtherObject2->new(id => 7, name => 'seven'), MyMySQLOtherObject2->new(id => 12, name => 'one'), ); ok($o->other2_objs_on_save(\@o2s), "set 2 one to many on save 1 - $db_type"); $o2 = MyMySQLOtherObject2->new(id => 7)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many on save 2 - $db_type"); ok(!MyMySQLOtherObject2->new(id => 12)->load(speculative => 1), "set 2 one to many on save 3 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_other2 WHERE pid = 222'); $sth->execute; $count = $sth->fetchrow_array; is($count, 3, "set 2 one to many on save 4 - $db_type"); @o2s = $o->other2_objs_on_save; ok(@o2s == 2, "set 2 one to many on save 5 - $db_type"); ok($o2s[0]->id == 7 && $o2s[0]->pid == 222, "set 2 one to many on save 6 - $db_type"); ok($o2s[1]->id == 12 && $o2s[1]->pid == 222, "set 2 one to many on save 7 - $db_type"); $o->save; @o2s = $o->other2_objs_on_save; ok(@o2s == 2, "set one to many on save 8 - $db_type"); ok($o2s[0]->id == 7 && $o2s[0]->pid == 222, "set 2 one to many on save 9 - $db_type"); ok($o2s[1]->id == 12 && $o2s[1]->pid == 222, "set 2 one to many on save 10 - $db_type"); $o2 = MyMySQLOtherObject2->new(id => 7)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many on save 11 - $db_type"); $o2 = MyMySQLOtherObject2->new(id => 12)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many on save 12 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_other2 WHERE pid = 222'); $sth->execute; $count = $sth->fetchrow_array; is($count, 2, "set one to many on save 15 - $db_type"); # Set to undef $o->other2_objs_on_save(undef); @o2s = $o->other2_objs_on_save; ok(@o2s == 2, "set one to many on save 16 - $db_type"); ok($o2s[0]->id == 7 && $o2s[0]->pid == 222, "set 2 one to many on save 17 - $db_type"); ok($o2s[1]->id == 12 && $o2s[1]->pid == 222, "set 2 one to many on save 18 - $db_type"); $o2 = MyMySQLOtherObject2->new(id => 7)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many on save 19 - $db_type"); $o2 = MyMySQLOtherObject2->new(id => 12)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many on save 20 - $db_type"); # # "one to many" add_now # # SETUP $o2->db->dbh->do('DELETE FROM rose_db_object_other2'); $o = MyMySQLObject->new(id => 333, name => 'Zoom', flag => 1); $o->save; @o2s = ( MyMySQLOtherObject2->new(id => 5, name => 'five'), MyMySQLOtherObject2->new(id => 6, name => 'six'), MyMySQLOtherObject2->new(id => 7, name => 'seven'), ); $o->other2_objs_now(@o2s); # RESET $o = MyMySQLObject->new(id => 333, name => 'Zoom', flag => 1); # Add, no args @o2s = (); ok($o->add_other2_objs_now(@o2s) == 0, "add one to many now 1 - $db_type"); # Add before load/save @o2s = ( MyMySQLOtherObject2->new(id => 8, name => 'eight'), ); eval { $o->add_other2_objs_now(@o2s) }; ok($@, "add one to many now 2 - $db_type"); # Add $o->load; my @oret = $o->add_other2_objs_now(@o2s); is(scalar @oret, scalar @o2s && $oret[0] eq $o2s[0] && $oret[0]->isa('MyMySQLOtherObject2'), "add one to many now count - $db_type"); @o2s = $o->other2_objs; ok(@o2s == 4, "add one to many now 3 - $db_type"); ok($o2s[0]->id == 6 && $o2s[0]->pid == 333, "add one to many now 4 - $db_type"); ok($o2s[1]->id == 7 && $o2s[1]->pid == 333, "add one to many now 5 - $db_type"); ok($o2s[2]->id == 5 && $o2s[2]->pid == 333, "add one to many now 6 - $db_type"); ok($o2s[3]->id == 8 && $o2s[3]->pid == 333, "add one to many now 7 - $db_type"); ok(MyMySQLOtherObject2->new(id => 6)->load(speculative => 1), "add one to many now 8 - $db_type"); ok(MyMySQLOtherObject2->new(id => 7)->load(speculative => 1), "add one to many now 9 - $db_type"); ok(MyMySQLOtherObject2->new(id => 5)->load(speculative => 1), "add one to many now 10 - $db_type"); ok(MyMySQLOtherObject2->new(id => 8)->load(speculative => 1), "add one to many now 11 - $db_type"); # # "one to many" add_on_save # # SETUP $o2->db->dbh->do('DELETE FROM rose_db_object_other2'); $o = MyMySQLObject->new(id => 444, name => 'Blargh', flag => 1); # Set on save, add on save, save @o2s = ( MyMySQLOtherObject2->new(id => 10, name => 'ten'), ); # Set on save $o->other2_objs_on_save(@o2s); @o2s = $o->other2_objs; ok(@o2s == 1, "add one to many on save 1 - $db_type"); ok($o2s[0]->id == 10 && $o2s[0]->pid == 444, "add one to many on save 2 - $db_type"); ok(!MyMySQLOtherObject2->new(id => 10)->load(speculative => 1), "add one to many on save 3 - $db_type"); @o2s = ( MyMySQLOtherObject2->new(id => 9, name => 'nine'), ); # Add on save ok($o->add_other2_objs(@o2s), "add one to many on save 4 - $db_type"); @o2s = $o->other2_objs; ok(@o2s == 2, "add one to many on save 5 - $db_type"); ok($o2s[0]->id == 10 && $o2s[0]->pid == 444, "add one to many on save 6 - $db_type"); ok($o2s[1]->id == 9 && $o2s[0]->pid == 444, "add one to many on save 7 - $db_type"); ok(!MyMySQLOtherObject2->new(id => 10)->load(speculative => 1), "add one to many on save 8 - $db_type"); ok(!MyMySQLOtherObject2->new(id => 9)->load(speculative => 1), "add one to many on save 9 - $db_type"); $o->save; @o2s = $o->other2_objs; ok(@o2s == 2, "add one to many on save 10 - $db_type"); ok($o2s[0]->id == 10 && $o2s[0]->pid == 444, "add one to many on save 11 - $db_type"); ok($o2s[1]->id == 9 && $o2s[1]->pid == 444, "add one to many on save 12 - $db_type"); ok(MyMySQLOtherObject2->new(id => 10)->load(speculative => 1), "add one to many on save 13 - $db_type"); ok(MyMySQLOtherObject2->new(id => 9)->load(speculative => 1), "add one to many on save 14 - $db_type"); # RESET $o = MyMySQLObject->new(id => 444, name => 'Blargh', flag => 1); $o->load; # Add on save, save @o2s = ( MyMySQLOtherObject2->new(id => 11, name => 'eleven'), ); # Add on save ok($o->add_other2_objs(\@o2s), "add one to many on save 15 - $db_type"); @o2s = $o->other2_objs; ok(@o2s == 2, "add one to many on save 16 - $db_type"); ok($o2s[0]->id == 10 && $o2s[0]->pid == 444, "add one to many on save 17 - $db_type"); ok($o2s[1]->id == 9 && $o2s[1]->pid == 444, "add one to many on save 18 - $db_type"); ok(MyMySQLOtherObject2->new(id => 10)->load(speculative => 1), "add one to many on save 19 - $db_type"); ok(MyMySQLOtherObject2->new(id => 9)->load(speculative => 1), "add one to many on save 20 - $db_type"); ok(!MyMySQLOtherObject2->new(id => 11)->load(speculative => 1), "add one to many on save 21 - $db_type"); # Save $o->save; @o2s = $o->other2_objs; ok(@o2s == 3, "add one to many on save 22 - $db_type"); ok($o2s[0]->id == 10 && $o2s[0]->pid == 444, "add one to many on save 23 - $db_type"); ok($o2s[1]->id == 9 && $o2s[1]->pid == 444, "add one to many on save 24 - $db_type"); ok($o2s[2]->id == 11 && $o2s[2]->pid == 444, "add one to many on save 25 - $db_type"); ok(MyMySQLOtherObject2->new(id => 10)->load(speculative => 1), "add one to many on save 26 - $db_type"); ok(MyMySQLOtherObject2->new(id => 9)->load(speculative => 1), "add one to many on save 27 - $db_type"); ok(MyMySQLOtherObject2->new(id => 11)->load(speculative => 1), "add one to many on save 28 - $db_type"); # End "one to many" method tests # Start "load with ..." tests ok($o = MyMySQLObject->new(id => 444)->load(with => [ qw(other_obj other2_objs colors) ]), "load with 1 - $db_type"); ok($o->{'other2_objs'} && $o->{'other2_objs'}[1]->name eq 'nine', "load with 2 - $db_type"); $o = MyMySQLObject->new(id => 999); ok(!$o->load(with => [ qw(other_obj other2_objs colors) ], speculative => 1), "load with 3 - $db_type"); $o = MyMySQLObject->new(id => 222); ok($o->load(with => 'colors'), "load with 4 - $db_type"); # End "load with ..." tests # Start "many to many" tests # # "many to many" get_set_now # # SETUP $o = MyMySQLObject->new(id => 30, name => 'Color', flag => 1); # Set @colors = ( 1, # red MyMySQLColor->new(id => 3), # blue { id => 5, name => 'orange' }, ); #MyMySQLColor->new(id => 2), # green #MyMySQLColor->new(id => 4), # pink # Set before save, save, set eval { $o->colors_now(@colors) }; ok($@, "set many to many now 1 - $db_type"); $o->save; ok($o->colors_now(@colors), "set many to many now 2 - $db_type"); @colors = $o->colors_now; ok(@colors == 3, "set many to many now 3 - $db_type"); ok($colors[0]->id == 3, "set many to many now 4 - $db_type"); ok($colors[1]->id == 5, "set many to many now 5 - $db_type"); ok($colors[2]->id == 1, "set many to many now 6 - $db_type"); $color = MyMySQLColor->new(id => 5); ok($color->load(speculative => 1), "set many to many now 7 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 30, color_id => 3)->load(speculative => 1), "set many to many now 8 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 30, color_id => 5)->load(speculative => 1), "set many to many now 9 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 30, color_id => 1)->load(speculative => 1), "set many to many now 10 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 30'); $sth->execute; $count = $sth->fetchrow_array; is($count, 3, "set many to many now 11 - $db_type"); # Set to undef $o->colors_now(undef); @colors = $o->colors_now; ok(@colors == 3, "set 2 many to many now 1 - $db_type"); ok($colors[0]->id == 3, "set 2 many to many now 2 - $db_type"); ok($colors[1]->id == 5, "set 2 many to many now 3 - $db_type"); ok($colors[2]->id == 1, "set 2 many to many now 4 - $db_type"); $color = MyMySQLColor->new(id => 5); ok($color->load(speculative => 1), "set 2 many to many now 5 - $db_type"); $color = MyMySQLColor->new(id => 3); ok($color->load(speculative => 1), "set 2 many to many now 6 - $db_type"); $color = MyMySQLColor->new(id => 1); ok($color->load(speculative => 1), "set 2 many to many now 7 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 30, color_id => 3)->load(speculative => 1), "set 2 many to many now 8 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 30, color_id => 5)->load(speculative => 1), "set 2 many to many now 9 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 30, color_id => 1)->load(speculative => 1), "set 2 many to many now 10 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 30'); $sth->execute; $count = $sth->fetchrow_array; is($count, 3, "set 2 many to many now 11 - $db_type"); # # "many to many" get_set_on_save # # SETUP $o = MyMySQLObject->new(id => 40, name => 'Cool', flag => 1); # Set @colors = ( MyMySQLColor->new(id => 1), # red 3, # blue { id => 6, name => 'ochre' }, ); #MyMySQLColor->new(id => 2), # green #MyMySQLColor->new(id => 4), # pink $o->colors_on_save(@colors); @colors = $o->colors_on_save; ok(@colors == 3, "set many to many on save 1 - $db_type"); ok($colors[0]->id == 1, "set many to many on save 2 - $db_type"); ok($colors[1]->id == 3, "set many to many on save 3 - $db_type"); ok($colors[2]->id == 6, "set many to many on save 4 - $db_type"); ok(MyMySQLColor->new(id => 1)->load(speculative => 1), "set many to many on save 5 - $db_type"); ok(MyMySQLColor->new(id => 3)->load(speculative => 1), "set many to many on save 6 - $db_type"); ok(!MyMySQLColor->new(id => 6)->load(speculative => 1), "set many to many on save 7 - $db_type"); ok(!MyMySQLColorMap->new(obj_id => 40, color_id => 1)->load(speculative => 1), "set many to many on save 8 - $db_type"); ok(!MyMySQLColorMap->new(obj_id => 40, color_id => 3)->load(speculative => 1), "set many to many on save 9 - $db_type"); ok(!MyMySQLColorMap->new(obj_id => 40, color_id => 6)->load(speculative => 1), "set many to many on save 10 - $db_type"); $o->save; @colors = $o->colors_on_save; ok(@colors == 3, "set many to many on save 11 - $db_type"); ok($colors[0]->id == 3, "set many to many on save 12 - $db_type"); ok($colors[1]->id == 6, "set many to many on save 13 - $db_type"); ok($colors[2]->id == 1, "set many to many on save 14 - $db_type"); ok(MyMySQLColor->new(id => 1)->load(speculative => 1), "set many to many on save 15 - $db_type"); ok(MyMySQLColor->new(id => 3)->load(speculative => 1), "set many to many on save 16 - $db_type"); ok(MyMySQLColor->new(id => 6)->load(speculative => 1), "set many to many on save 17 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 40, color_id => 1)->load(speculative => 1), "set 2 many to many on save 18 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 40, color_id => 3)->load(speculative => 1), "set 2 many to many on save 19 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 40, color_id => 6)->load(speculative => 1), "set 2 many to many on save 20 - $db_type"); $sth = $color->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 40'); $sth->execute; $count = $sth->fetchrow_array; is($count, 3, "set many to many on save 21 - $db_type"); # RESET $o = MyMySQLObject->new(id => 40)->load; # Set to undef $o->colors_on_save(undef); @colors = $o->colors_on_save; ok(@colors == 3, "set 2 many to many on save 1 - $db_type"); ok($colors[0]->id == 3, "set 2 many to many on save 2 - $db_type"); ok($colors[1]->id == 6, "set 2 many to many on save 3 - $db_type"); ok($colors[2]->id == 1, "set 2 many to many on save 4 - $db_type"); ok(MyMySQLColor->new(id => 1)->load(speculative => 1), "set 2 many to many on save 5 - $db_type"); ok(MyMySQLColor->new(id => 3)->load(speculative => 1), "set 2 many to many on save 6 - $db_type"); ok(MyMySQLColor->new(id => 6)->load(speculative => 1), "set 2 many to many on save 7 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 40, color_id => 1)->load(speculative => 1), "set 2 many to many on save 8 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 40, color_id => 3)->load(speculative => 1), "set 2 many to many on save 9 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 40, color_id => 6)->load(speculative => 1), "set 2 many to many on save 10 - $db_type"); $sth = $color->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 40'); $sth->execute; $count = $sth->fetchrow_array; is($count, 3, "set 2 many to many on save 11 - $db_type"); $o->colors([]); $o->save(changes_only => 1); $o->colors_on_save({ id => 1, name => 'redx' }, { id => 3 }); $o->save(changes_only => 1); $o->colors_on_save(undef); $colors = $o->colors_on_save; ok(ref $colors eq 'ARRAY' && @$colors == 2 && $colors->[0]->name eq 'blue' && $colors->[1]->name eq 'redx', "colors merge 1 - $db_type"); $o->colors_on_save({ id => 2 }, { id => 3, name => 'bluex' }); $o->save(changes_only => 1); $o->colors_on_save(undef); $colors = $o->colors_on_save; ok(ref $colors eq 'ARRAY' && @$colors == 2 && $colors->[0]->name eq 'bluex' && $colors->[1]->name eq 'green', "colors merge 2 - $db_type"); # # "many to many" add_now # # SETUP $o = MyMySQLObject->new(id => 50, name => 'Blat', flag => 1); $o->delete; @colors = ( MyMySQLColor->new(id => 1), # red MyMySQLColor->new(id => 3), # blue ); #MyMySQLColor->new(id => 4), # pink $o->colors_on_save(\@colors); $o->save; $o = MyMySQLObject->new(id => 50, name => 'Blat', flag => 1); # Add, no args @colors = (); ok($o->add_colors(@colors) == 0, "add many to many now 1 - $db_type"); # Add before load/save @colors = ( MyMySQLColor->new(id => 7, name => 'puce'), MyMySQLColor->new(id => 2), # green ); eval { $o->add_colors(@colors) }; ok($@, "add many to many now 2 - $db_type"); # Add $o->load; $o->add_colors(@colors); @colors = $o->colors; ok(@colors == 4, "add many to many now 3 - $db_type"); ok($colors[0]->id == 3, "add many to many now 4 - $db_type"); ok($colors[1]->id == 2, "add many to many now 5 - $db_type"); ok($colors[2]->id == 7, "add many to many now 6 - $db_type"); ok($colors[3]->id == 1, "add many to many now 7 - $db_type"); ok(MyMySQLColor->new(id => 3)->load(speculative => 1), "add many to many now 8 - $db_type"); ok(MyMySQLColor->new(id => 2)->load(speculative => 1), "add many to many now 9 - $db_type"); ok(MyMySQLColor->new(id => 7)->load(speculative => 1), "add many to many now 10 - $db_type"); ok(MyMySQLColor->new(id => 1)->load(speculative => 1), "add many to many now 11 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 50, color_id => 3)->load(speculative => 1), "set 2 many to many on save 12 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 50, color_id => 2)->load(speculative => 1), "set 2 many to many on save 13 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 50, color_id => 7)->load(speculative => 1), "set 2 many to many on save 14 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 50, color_id => 1)->load(speculative => 1), "set 2 many to many on save 15 - $db_type"); # # "many to many" add_on_save # # SETUP $o = MyMySQLObject->new(id => 60, name => 'Cretch', flag => 1); $o->delete; # Set on save, add on save, save @colors = ( MyMySQLColor->new(id => 1), # red MyMySQLColor->new(id => 2), # green ); # Set on save $o->colors_on_save(@colors); @colors = ( MyMySQLColor->new(id => 7), # puce MyMySQLColor->new(id => 8, name => 'tan'), ); # Add on save ok($o->add_colors_on_save(@colors), "add many to many on save 1 - $db_type"); @colors = $o->colors; ok(@colors == 4, "add many to many on save 2 - $db_type"); ok($colors[0]->id == 1, "add many to many on save 3 - $db_type"); ok($colors[1]->id == 2, "add many to many on save 4 - $db_type"); ok($colors[2]->id == 7, "add many to many on save 5 - $db_type"); ok($colors[3]->id == 8, "add many to many on save 6 - $db_type"); ok(MyMySQLColor->new(id => 1)->load(speculative => 1), "add many to many on save 7 - $db_type"); ok(MyMySQLColor->new(id => 2)->load(speculative => 1), "add many to many on save 8 - $db_type"); ok(MyMySQLColor->new(id => 7)->load(speculative => 1), "add many to many on save 9 - $db_type"); ok(!MyMySQLColor->new(id => 8)->load(speculative => 1), "add many to many on save 10 - $db_type"); ok(!MyMySQLColorMap->new(obj_id => 60, color_id => 1)->load(speculative => 1), "set many to many on save 11 - $db_type"); ok(!MyMySQLColorMap->new(obj_id => 60, color_id => 2)->load(speculative => 1), "set many to many on save 12 - $db_type"); ok(!MyMySQLColorMap->new(obj_id => 60, color_id => 7)->load(speculative => 1), "set many to many on save 13 - $db_type"); ok(!MyMySQLColorMap->new(obj_id => 60, color_id => 8)->load(speculative => 1), "set many to many on save 14 - $db_type"); $o->save; @colors = $o->colors; ok(@colors == 4, "add many to many on save 15 - $db_type"); ok($colors[0]->id == 2, "add many to many on save 16 - $db_type"); ok($colors[1]->id == 7, "add many to many on save 17 - $db_type"); ok($colors[2]->id == 1, "add many to many on save 18 - $db_type"); ok($colors[3]->id == 8, "add many to many on save 19 - $db_type"); ok(MyMySQLColor->new(id => 2)->load(speculative => 1), "add many to many on save 20 - $db_type"); ok(MyMySQLColor->new(id => 7)->load(speculative => 1), "add many to many on save 21 - $db_type"); ok(MyMySQLColor->new(id => 1)->load(speculative => 1), "add many to many on save 22 - $db_type"); ok(MyMySQLColor->new(id => 8)->load(speculative => 1), "add many to many on save 21 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 60, color_id => 2)->load(speculative => 1), "add many to many on save 22 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 60, color_id => 7)->load(speculative => 1), "add many to many on save 23 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 60, color_id => 1)->load(speculative => 1), "add many to many on save 24 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 60, color_id => 8)->load(speculative => 1), "add many to many on save 25 - $db_type"); $sth = $color->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 60'); $sth->execute; $count = $sth->fetchrow_array; is($count, 4, "add many to many on save 26 - $db_type"); # RESET $o = MyMySQLObject->new(id => 60, name => 'Cretch', flag => 1); $o->load(with => 'colors'); # Add on save, save @colors = ( MyMySQLColor->new(id => 9, name => 'aqua'), ); # Add on save ok($o->add_colors_on_save(@colors), "add 2 many to many on save 1 - $db_type"); @colors = $o->colors; ok(@colors == 5, "add 2 many to many on save 16 - $db_type"); ok($colors[0]->id == 2, "add 2 many to many on save 2 - $db_type"); ok($colors[1]->id == 7, "add 2 many to many on save 3 - $db_type"); ok($colors[2]->id == 1, "add 2 many to many on save 4 - $db_type"); ok($colors[3]->id == 8, "add 2 many to many on save 5 - $db_type"); ok($colors[4]->id == 9, "add 2 many to many on save 6 - $db_type"); ok(MyMySQLColor->new(id => 2)->load(speculative => 1), "add many to many on save 7 - $db_type"); ok(MyMySQLColor->new(id => 7)->load(speculative => 1), "add many to many on save 8 - $db_type"); ok(MyMySQLColor->new(id => 1)->load(speculative => 1), "add many to many on save 9 - $db_type"); ok(MyMySQLColor->new(id => 8)->load(speculative => 1), "add many to many on save 10 - $db_type"); ok(!MyMySQLColor->new(id => 9)->load(speculative => 1), "add many to many on save 11 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 60, color_id => 2)->load(speculative => 1), "add 2 many to many on save 12 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 60, color_id => 7)->load(speculative => 1), "add 2 many to many on save 13 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 60, color_id => 1)->load(speculative => 1), "add 2 many to many on save 14 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 60, color_id => 8)->load(speculative => 1), "add 2 many to many on save 15 - $db_type"); ok(!MyMySQLColorMap->new(obj_id => 60, color_id => 9)->load(speculative => 1), "add 2 many to many on save 16 - $db_type"); $sth = $color->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 60'); $sth->execute; $count = $sth->fetchrow_array; is($count, 4, "add 2 many to many on save 17 - $db_type"); # Save $o->save; @colors = $o->colors; ok(@colors == 5, "add 2 many to many on save 18 - $db_type"); ok($colors[0]->id == 9, "add 2 many to many on save 19 - $db_type"); ok($colors[1]->id == 2, "add 2 many to many on save 20 - $db_type"); ok($colors[2]->id == 7, "add 2 many to many on save 21 - $db_type"); ok($colors[3]->id == 1, "add 2 many to many on save 22 - $db_type"); ok($colors[4]->id == 8, "add 2 many to many on save 23 - $db_type"); ok(MyMySQLColor->new(id => 9)->load(speculative => 1), "add many to many on save 24 - $db_type"); ok(MyMySQLColor->new(id => 2)->load(speculative => 1), "add many to many on save 25 - $db_type"); ok(MyMySQLColor->new(id => 7)->load(speculative => 1), "add many to many on save 26 - $db_type"); ok(MyMySQLColor->new(id => 1)->load(speculative => 1), "add many to many on save 27 - $db_type"); ok(MyMySQLColor->new(id => 8)->load(speculative => 1), "add many to many on save 28 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 60, color_id => 9)->load(speculative => 1), "add 2 many to many on save 29 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 60, color_id => 2)->load(speculative => 1), "add 2 many to many on save 20 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 60, color_id => 7)->load(speculative => 1), "add 2 many to many on save 31 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 60, color_id => 1)->load(speculative => 1), "add 2 many to many on save 32 - $db_type"); ok(MyMySQLColorMap->new(obj_id => 60, color_id => 8)->load(speculative => 1), "add 2 many to many on save 33 - $db_type"); $sth = $color->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 60'); $sth->execute; $count = $sth->fetchrow_array; is($count, 5, "add 2 many to many on save 34 - $db_type"); # End "many to many" tests # Start "one to one" cascaded delete tests #local $Rose::DB::Object::Debug = 1; #local $Rose::DB::Object::Manager::Debug = 1; $o = MyMySQLObject->new(name => '1to1bug', fk1 => 10, fk2 => 20, fk3 => 30, other_obj_otoo => { name => '1to1bugfo', k1 => 10, k2 => 20, k3 => 30, }); $o->save; $o = MyMySQLObject->new(id => $o->id)->load; ok(defined $o->other_obj_otoo, "delete(cascade => 1) one to one prep - $db_type"); $o = MyMySQLObject->new(id => $o->id); $o->delete(cascade => 1); ok(!MyMySQLOtherObject->new(k1 => 10, k2 => 20, k3 => 30)->load(speculative => 1), "delete(cascade => 1) one to one delete - $db_type"); # XXX: This relies on MySQL's creepy behavior of setting not-null # XXX: columns to 0 when they are set to NULL by a query. # # $o = MyMySQLObject->new(name => '1to1bug2', # fk1 => 10, # fk2 => 20, # fk3 => 30, # other_obj_otoo => # { # name => '1to1bugfo2', # k1 => 10, # k2 => 20, # k3 => 30, # }); # # $o->save; # # $o = MyMySQLObject->new(id => $o->id)->load; # # ok(defined $o->other_obj_otoo, "delete(cascade => 1) one to one prep - $db_type"); # # $o = MyMySQLObject->new(id => $o->id); # $o->delete(cascade => 'null'); # # ok(MyMySQLOtherObject->new(k1 => 0, k2 => 0, k3 => 0)->load(speculative => 1), # "delete(cascade => 1) one to one null - $db_type"); # End "one to one" cascaded delete tests # Start fk hook-up tests $o2 = MyMySQLOtherObject2->new(name => 'B', pid => 11); $o2->save; $o = MyMySQLObject->new(name => 'John', id => 12); $o->add_other2_objs2($o2); $o2->name('John2'); $o->save; $o2 = MyMySQLOtherObject2->new(id => $o2->id)->load; is($o2->pid, $o->id, "fk hook-up 1 - $db_type"); is($o2->name, 'John2', "fk hook-up 2 - $db_type"); # End fk hook-up tests } # # Informix # SKIP: foreach my $db_type ('informix') { skip("Informix tests", 378) unless($HAVE_INFORMIX); Rose::DB->default_type($db_type); my $o = MyInformixObject->new(name => 'John', id => 1); ok(ref $o && $o->isa('MyInformixObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(7); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); my $o_x = MyInformixObject->new(id => 99, name => 'John X', flag => 0); $o_x->save; my $o2 = MyInformixObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyInformixObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 7, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyInformixObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyInformixObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->load, "load() 4 - $db_type"); my $o5 = MyInformixObject->new(id => $o->id); ok($o5->load, "load() 5 - $db_type"); $o5->nums([ 4, 5, 6 ]); ok($o5->save, "save() 4 - $db_type"); ok($o->load, "load() 6 - $db_type"); is($o5->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o5->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o5->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o5->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); my $oo1 = MyInformixOtherObject->new(k1 => 1, k2 => 2, k3 => 3, name => 'one'); ok($oo1->save, "other object save() 1 - $db_type"); my $oo2 = MyInformixOtherObject->new(k1 => 11, k2 => 12, k3 => 13, name => 'two'); ok($oo2->save, "other object save() 2 - $db_type"); is($o->other_obj, undef, "other_obj() 1 - $db_type"); $o->fkone(99); $o->fk2(99); $o->fk3(99); eval { $o->other_obj }; ok($@, "fatal referential_integrity - $db_type"); ok(!defined $o->other_obj_osoft, "ok referential_integrity 1 - $db_type"); ok(!defined $o->other_obj_msoft, "ok referential_integrity 2 - $db_type"); $o->fkone(1); $o->fk2(2); $o->fk3(3); my $obj = $o->other_obj or warn "# ", $o->error, "\n"; is(ref $obj, 'MyInformixOtherObject', "other_obj() 2 - $db_type"); is($obj->name, 'one', "other_obj() 3 - $db_type"); $o->other_obj(undef); $o->fkone(11); $o->fk2(12); $o->fk3(13); ok(!$o->has_loaded_related('other_obj'), "has_loaded_related() 1 - $db_type"); $obj = $o->other_obj or warn "# ", $o->error, "\n"; ok($o->has_loaded_related('other_obj'), "has_loaded_related() 2 - $db_type"); is(ref $obj, 'MyInformixOtherObject', "other_obj() 4 - $db_type"); is($obj->name, 'two', "other_obj() 5 - $db_type"); my $oo21 = MyInformixOtherObject2->new(id => 1, name => 'one', pid => $o->id); ok($oo21->save, "other object 2 save() 1 - $db_type"); my $oo22 = MyInformixOtherObject2->new(id => 2, name => 'two', pid => $o->id); ok($oo22->save, "other object 2 save() 2 - $db_type"); my $oo23 = MyInformixOtherObject2->new(id => 3, name => 'three', pid => $o_x->id); ok($oo23->save, "other object 2 save() 3 - $db_type"); # Begin filtered collection tests my $x = MyInformixObject->new(id => $o->id)->load; $x->other2_a_objs({ id => 100, name => 'aoo' }, { id => 101, name => 'abc' }); $x->save; $x = MyInformixObject->new(id => $o->id)->load; my $ao = $x->other2_a_objs; my $oo = $x->other2_objs; is(scalar @$ao, 2, "filtered one-to-many 1 - $db_type"); is(join(',', map { $_->name } @$ao), 'abc,aoo', "filtered one-to-many 2 - $db_type"); is(scalar @$oo, 4, "filtered one-to-many 3 - $db_type"); is(join(',', sort map { $_->name } @$oo), 'abc,aoo,one,two', "filtered one-to-many 4 - $db_type"); $x->other2_a_objs({ id => 102, name => 'axx' }); $x->save; $x = MyInformixObject->new(id => $o->id)->load; $ao = $x->other2_a_objs; $oo = $x->other2_objs; is(scalar @$ao, 1, "filtered one-to-many 5 - $db_type"); is(join(',', map { $_->name } @$ao), 'axx', "filtered one-to-many 6 - $db_type"); is(scalar @$oo, 3, "filtered one-to-many 7 - $db_type"); is(join(',', sort map { $_->name } @$oo), 'axx,one,two', "filtered one-to-many 8 - $db_type"); $x->other2_a_objs([]); $x->save; # End filtered collection tests ok(!$o->has_loaded_related('other2_objs'), "has_loaded_related() 3 - $db_type"); my $o2s = $o->other2_objs; ok($o->has_loaded_related('other2_objs'), "has_loaded_related() 4 - $db_type"); ok(ref $o2s eq 'ARRAY' && @$o2s == 2 && $o2s->[0]->name eq 'two' && $o2s->[1]->name eq 'one', 'other objects 1'); my @o2s = $o->other2_objs; ok(@o2s == 2 && $o2s[0]->name eq 'two' && $o2s[1]->name eq 'one', 'other objects 2'); my $color = MyInformixColor->new(id => 1, name => 'red'); ok($color->save, "save color 1 - $db_type"); $color = MyInformixColor->new(id => 2, name => 'green'); ok($color->save, "save color 2 - $db_type"); $color = MyInformixColor->new(id => 3, name => 'blue'); ok($color->save, "save color 3 - $db_type"); $color = MyInformixColor->new(id => 4, name => 'pink'); ok($color->save, "save color 4 - $db_type"); my $map1 = MyInformixColorMap->new(obj_id => 1, color_id => 1); ok($map1->save, "save color map record 1 - $db_type"); my $map2 = MyInformixColorMap->new(obj_id => 1, color_id => 3); ok($map2->save, "save color map record 2 - $db_type"); my $map3 = MyInformixColorMap->new(obj_id => 99, color_id => 4); ok($map3->save, "save color map record 3 - $db_type"); my $colors = $o->colors; ok(ref $colors eq 'ARRAY' && @$colors == 2 && $colors->[0]->name eq 'blue' && $colors->[1]->name eq 'red', "colors 1 - $db_type"); $colors = $o->find_colors; ok(ref $colors eq 'ARRAY' && @$colors == 2 && $colors->[0]->name eq 'blue' && $colors->[1]->name eq 'red', "find colors 1 - $db_type"); $colors = $o->find_colors([ name => { like => 'r%' } ]); ok(ref $colors eq 'ARRAY' && @$colors == 1 && $colors->[0]->name eq 'red', "find colors 2 - $db_type"); $colors = $o->find_colors(query => [ name => { like => 'r%' } ], cache => 1); my $colors2 = $o->find_colors(from_cache => 1); ok(ref $colors eq 'ARRAY' && @$colors == 1 && $colors->[0]->name eq 'red' && ref $colors2 eq 'ARRAY' && @$colors2 == 1 && $colors2->[0]->name eq 'red' && $colors->[0] eq $colors2->[0], "find colors from cache - $db_type"); my $count = $o->colors_count; is($count, 2, "count colors 1 - $db_type"); $count = $o->colors_count([ name => { like => 'r%' } ]); is($count, 1, "count colors 2 - $db_type"); my @colors = $o->colors; ok(@colors == 2 && $colors[0]->name eq 'blue' && $colors[1]->name eq 'red', "colors 2 - $db_type"); $colors = $o_x->colors; ok(ref $colors eq 'ARRAY' && @$colors == 1 && $colors->[0]->name eq 'pink', "colors 3 - $db_type"); @colors = $o_x->colors; ok(@colors == 1 && $colors[0]->name eq 'pink', "colors 4 - $db_type"); $o = MyInformixObject->new(id => 1)->load; $o->fkone(1); $o->fk2(2); $o->fk3(3); $o->save; #local $Rose::DB::Object::Manager::Debug = 1; eval { local $o->dbh->{'PrintError'} = 0; $o->delete(cascade => 'null'); }; ok($@, "delete cascade null 1 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( db => $o->db, object_class => 'MyInformixOtherObject'); is($count, 2, "delete cascade rollback confirm 1 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( db => $o->db, object_class => 'MyInformixOtherObject2'); is($count, 3, "delete cascade rollback confirm 2 - $db_type"); ok($o->delete(cascade => 'delete'), "delete cascade delete 1 - $db_type"); $o = MyInformixObject->new(id => 99)->load; $o->fkone(11); $o->fk2(12); $o->fk3(13); $o->save; eval { local $o->dbh->{'PrintError'} = 0; $o->delete(cascade => 'null'); }; ok($@, "delete cascade null 2 - $db_type"); ok($o->delete(cascade => 'delete'), "delete cascade delete 2 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( db => $o->db, object_class => 'MyInformixColorMap'); is($count, 0, "delete cascade confirm 1 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( db => $o->db, object_class => 'MyInformixOtherObject2'); is($count, 0, "delete cascade confirm 2 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( db => $o->db, object_class => 'MyInformixOtherObject'); is($count, 0, "delete cascade confirm 3 - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, "alias_column() nonesuch - $db_type"); # Start foreign key method tests # # Foreign key get_set_now # $o = MyInformixObject->new(id => 50, name => 'Alex', flag => 1); eval { $o->other_obj('abc') }; ok($@, "set foreign key object: one arg - $db_type"); eval { $o->other_obj(k1 => 1, k2 => 2, k3 => 3) }; ok($@, "set foreign key object: no save - $db_type"); $o->save; eval { local $o->db->dbh->{'PrintError'} = 0; $o->other_obj(k1 => 1, k2 => 2); }; ok($@, "set foreign key object: too few keys - $db_type"); ok($o->other_obj(k1 => 1, k2 => 2, k3 => 3), "set foreign key object 1 - $db_type"); ok($o->fkone == 1 && $o->fk2 == 2 && $o->fk3 == 3, "set foreign key object check keys 1 - $db_type"); ok($o->other_obj(k1 => 1, k2 => 2, k3 => 3), "set foreign key object 2 - $db_type"); ok($o->fkone == 1 && $o->fk2 == 2 && $o->fk3 == 3, "set foreign key object check keys 2 - $db_type"); # # Foreign key delete_now # ok($o->delete_other_obj, "delete foreign key object 1 - $db_type"); ok(!defined $o->fkone && !defined $o->fk2 && !defined $o->fk3, "delete foreign key object check keys 1 - $db_type"); ok(!defined $o->other_obj && defined $o->error, "delete foreign key object confirm 1 - $db_type"); ok(!defined $o->delete_other_obj, "delete foreign key object 2 - $db_type"); # # Foreign key get_set_on_save # # TEST: Set, save $o = MyInformixObject->new(id => 100, name => 'Bub', flag => 1); ok($o->other_obj_on_save(k1 => 21, k2 => 22, k3 => 23), "set foreign key object on save 1 - $db_type"); my $co = MyInformixObject->new(id => 100); ok(!$co->load(speculative => 1), "set foreign key object on save 2 - $db_type"); my $other_obj = $o->other_obj_on_save; ok($other_obj && $other_obj->k1 == 21 && $other_obj->k2 == 22 && $other_obj->k3 == 23, "set foreign key object on save 3 - $db_type"); ok($o->save, "set foreign key object on save 4 - $db_type"); $o = MyInformixObject->new(id => 100); $o->load; $other_obj = $o->other_obj_on_save; ok($other_obj && $other_obj && $other_obj->k1 == 21 && $other_obj->k2 == 22 && $other_obj->k3 == 23, "set foreign key object on save 5 - $db_type"); # TEST: Set, set to undef, save $o = MyInformixObject->new(id => 200, name => 'Rose', flag => 1); ok($o->other_obj_on_save(k1 => 51, k2 => 52, k3 => 53), "set foreign key object on save 6 - $db_type"); $co = MyInformixObject->new(id => 200); ok(!$co->load(speculative => 1), "set foreign key object on save 7 - $db_type"); $other_obj = $o->other_obj_on_save; ok($other_obj && $other_obj->k1 == 51 && $other_obj->k2 == 52 && $other_obj->k3 == 53, "set foreign key object on save 8 - $db_type"); $o->other_obj_on_save(undef); ok($o->save, "set foreign key object on save 9 - $db_type"); $o = MyInformixObject->new(id => 200); $o->load; ok(!defined $o->other_obj_on_save, "set foreign key object on save 10 - $db_type"); $co = MyInformixOtherObject->new(k1 => 51, k2 => 52, k3 => 53); ok(!$co->load(speculative => 1), "set foreign key object on save 11 - $db_type"); $o->delete(cascade => 1); # TEST: Set, delete, save $o = MyInformixObject->new(id => 200, name => 'Rose', flag => 1); ok($o->other_obj_on_save(k1 => 51, k2 => 52, k3 => 53), "set foreign key object on save 12 - $db_type"); $co = MyInformixObject->new(id => 200); ok(!$co->load(speculative => 1), "set foreign key object on save 13 - $db_type"); $other_obj = $o->other_obj_on_save; ok($other_obj && $other_obj->k1 == 51 && $other_obj->k2 == 52 && $other_obj->k3 == 53, "set foreign key object on save 14 - $db_type"); ok($o->delete_other_obj, "set foreign key object on save 15 - $db_type"); $other_obj = $o->other_obj_on_save; ok(!defined $other_obj && !defined $o->fkone && !defined $o->fk2 && !defined $o->fk3, "set foreign key object on save 16 - $db_type"); ok($o->save, "set foreign key object on save 17 - $db_type"); $o = MyInformixObject->new(id => 200); $o->load; ok(!defined $o->other_obj_on_save, "set foreign key object on save 18 - $db_type"); $co = MyInformixOtherObject->new(k1 => 51, k2 => 52, k3 => 53); ok(!$co->load(speculative => 1), "set foreign key object on save 19 - $db_type"); $o->delete(cascade => 1); # # Foreign key delete_on_save # $o = MyInformixObject->new(id => 500, name => 'Kip', flag => 1); $o->other_obj_on_save(k1 => 7, k2 => 8, k3 => 9); $o->save; $o = MyInformixObject->new(id => 500); $o->load; # TEST: Delete, save $o->del_other_obj_on_save; $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are undef... ok(!defined $other_obj && !defined $o->fkone && !defined $o->fk2 && !defined $o->fk3, "delete foreign key object on save 1 - $db_type"); # ...but that the foreign object has not yet been deleted $co = MyInformixOtherObject->new(k1 => 7, k2 => 8, k3 => 9); ok($co->load(speculative => 1), "delete foreign key object on save 2 - $db_type"); # Do the save ok($o->save, "delete foreign key object on save 3 - $db_type"); # Now it's deleted $co = MyInformixOtherObject->new(k1 => 7, k2 => 8, k3 => 9); ok(!$co->load(speculative => 1), "delete foreign key object on save 4 - $db_type"); $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are undef ok(!defined $other_obj && !defined $o->fkone && !defined $o->fk2 && !defined $o->fk3, "delete foreign key object on save 5 - $db_type"); # RESET $o->delete; $o = MyInformixObject->new(id => 700, name => 'Ham', flag => 0); $o->other_obj_on_save(k1 => 12, k2 => 34, k3 => 56); $o->save; $o = MyInformixObject->new(id => 700); $o->load; # TEST: Delete, set on save, delete, save ok($o->del_other_obj_on_save, "delete 2 foreign key object on save 1 - $db_type"); $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are undef... ok(!defined $other_obj && !defined $o->fkone && !defined $o->fk2 && !defined $o->fk3, "delete 2 foreign key object on save 2 - $db_type"); # ...but that the foreign object has not yet been deleted $co = MyInformixOtherObject->new(k1 => 12, k2 => 34, k3 => 56); ok($co->load(speculative => 1), "delete 3 foreign key object on save 3 - $db_type"); # Set on save $o->other_obj_on_save(k1 => 44, k2 => 55, k3 => 66); $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are set... ok($other_obj && $other_obj->k1 == 44 && $other_obj->k2 == 55 && $other_obj->k3 == 66, "delete 2 foreign key object on save 4 - $db_type"); # ...and that the foreign object has not yet been saved $co = MyInformixOtherObject->new(k1 => 44, k2 => 55, k3 => 66); ok(!$co->load(speculative => 1), "delete 2 foreign key object on save 5 - $db_type"); # Delete again ok($o->del_other_obj_on_save, "delete 2 foreign key object on save 6 - $db_type"); $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are undef... ok(!defined $other_obj && !defined $o->fkone && !defined $o->fk2 && !defined $o->fk3, "delete 2 foreign key object on save 7 - $db_type"); # Confirm that the foreign objects have not been saved $co = MyInformixOtherObject->new(k1 => 7, k2 => 8, k3 => 9); ok(!$co->load(speculative => 1), "delete 2 foreign key object on save 8 - $db_type"); $co = MyInformixOtherObject->new(k1 => 44, k2 => 55, k3 => 66); ok(!$co->load(speculative => 1), "delete 2 foreign key object on save 9 - $db_type"); # RESET $o->delete; $o = MyInformixObject->new(id => 800, name => 'Lee', flag => 1); $o->other_obj_on_save(k1 => 12, k2 => 34, k3 => 56); $o->save; $o = MyInformixObject->new(id => 800); $o->load; # TEST: Set & save, delete on save, set on save, delete on save, save ok($o->other_obj(k1 => 1, k2 => 2, k3 => 3), "delete 3 foreign key object on save 1 - $db_type"); # Confirm that both foreign objects are in the db $co = MyInformixOtherObject->new(k1 => 12, k2 => 34, k3 => 56); ok($co->load(speculative => 1), "delete 3 foreign key object on save 2 - $db_type"); $co = MyInformixOtherObject->new(k1 => 1, k2 => 2, k3 => 3); ok($co->load(speculative => 1), "delete 3 foreign key object on save 3 - $db_type"); # Delete on save $o->del_other_obj_on_save; # Set-on-save to old value $o->other_obj_on_save(k1 => 12, k2 => 34, k3 => 56); # Delete on save $o->del_other_obj_on_save; # Save $o->save; # Confirm that both foreign objects have been deleted $co = MyInformixOtherObject->new(k1 => 12, k2 => 34, k3 => 56); ok(!$co->load(speculative => 1), "delete 3 foreign key object on save 4 - $db_type"); $co = MyInformixOtherObject->new(k1 => 1, k2 => 2, k3 => 3); ok(!$co->load(speculative => 1), "delete 3 foreign key object on save 5 - $db_type"); # RESET $o->delete; $o = MyInformixObject->new(id => 900, name => 'Kai', flag => 1); $o->other_obj_on_save(k1 => 12, k2 => 34, k3 => 56); $o->save; $o = MyInformixObject->new(id => 900); $o->load; # TEST: Delete on save, set on save, delete on save, set to same one, save $o->del_other_obj_on_save; # Set on save ok($o->other_obj_on_save(k1 => 1, k2 => 2, k3 => 3), "delete 4 foreign key object on save 1 - $db_type"); # Delete on save $o->del_other_obj_on_save; # Set-on-save to previous value $o->other_obj_on_save(k1 => 1, k2 => 2, k3 => 3); # Save $o->save; $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are set... ok($other_obj && $other_obj->k1 == 1 && $other_obj->k2 == 2 && $other_obj->k3 == 3, "delete 4 foreign key object on save 2 - $db_type"); # Confirm that the new foreign object is there and the old one is not $co = MyInformixOtherObject->new(k1 => 1, k2 => 2, k3 => 3); ok($co->load(speculative => 1), "delete 4 foreign key object on save 3 - $db_type"); $co = MyInformixOtherObject->new(k1 => 12, k2 => 34, k3 => 56); ok(!$co->load(speculative => 1), "delete 4 foreign key object on save 4 - $db_type"); # End foreign key method tests # Start "one to many" method tests # # "one to many" get_set_now # #local $Rose::DB::Object::Debug = 1; #local $Rose::DB::Object::Manager::Debug = 1; # SETUP $o = MyInformixObject->new(id => 111, name => 'Boo', flag => 1); @o2s = ( 1, MyInformixOtherObject2->new(id => 2, name => 'two'), { id => 3, name => 'three' }, ); # Set before save, save, set eval { $o->other2_objs_now(@o2s) }; ok($@, "set one to many now 1 - $db_type"); $o->save; ok($o->other2_objs_now(@o2s), "set one to many now 2 - $db_type"); @o2s = $o->other2_objs_now; ok(@o2s == 3, "set one to many now 3 - $db_type"); ok($o2s[0]->id == 2 && $o2s[0]->pid == 111, "set one to many now 4 - $db_type"); ok($o2s[1]->id == 3 && $o2s[1]->pid == 111, "set one to many now 5 - $db_type"); ok($o2s[2]->id == 1 && $o2s[2]->pid == 111, "set one to many now 6 - $db_type"); $o2 = MyInformixOtherObject2->new(id => 1)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 7 - $db_type"); $o2 = MyInformixOtherObject2->new(id => 2)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 8 - $db_type"); $o2 = MyInformixOtherObject2->new(id => 3)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 9 - $db_type"); my $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_other2 WHERE pid = 111'); $sth->execute; $count = $sth->fetchrow_array; is($count, 3, "set one to many now 10 - $db_type"); # Set to undef $o->other2_objs_now(undef); @o2s = $o->other2_objs_now; ok(@o2s == 3, "set one to many now 11 - $db_type"); ok($o2s[0]->id == 2 && $o2s[0]->pid == 111, "set one to many now 12 - $db_type"); ok($o2s[1]->id == 3 && $o2s[1]->pid == 111, "set one to many now 13 - $db_type"); ok($o2s[2]->id == 1 && $o2s[2]->pid == 111, "set one to many now 14 - $db_type"); $o2 = MyInformixOtherObject2->new(id => 1)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 15 - $db_type"); $o2 = MyInformixOtherObject2->new(id => 2)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 16 - $db_type"); $o2 = MyInformixOtherObject2->new(id => 3)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 17 - $db_type"); # RESET $o = MyInformixObject->new(id => 111)->load; # Set (one existing, one new) @o2s = ( MyInformixOtherObject2->new(id => 1, name => 'one'), MyInformixOtherObject2->new(id => 7, name => 'seven'), ); ok($o->other2_objs_now(\@o2s), "set 2 one to many now 1 - $db_type"); $o2 = MyInformixOtherObject2->new(id => 1)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many now 2 - $db_type"); $o2 = MyInformixOtherObject2->new(id => 7)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many now 3 - $db_type"); @o2s = $o->other2_objs_now; ok(@o2s == 2, "set 2 one to many now 4 - $db_type"); ok($o2s[0]->id == 7 && $o2s[0]->pid == 111, "set 2 one to many now 5 - $db_type"); ok($o2s[1]->id == 1 && $o2s[1]->pid == 111, "set 2 one to many now 6 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_other2 WHERE pid = 111'); $sth->execute; $count = $sth->fetchrow_array; is($count, 2, "set 2 one to many now 7 - $db_type"); # # "one to many" get_set_on_save # # SETUP $o2->db->dbh->do('DELETE FROM rose_db_object_other2'); $o = MyInformixObject->new(id => 222, name => 'Hap', flag => 1); @o2s = ( MyInformixOtherObject2->new(id => 5, name => 'five'), MyInformixOtherObject2->new(id => 6, name => 'six'), MyInformixOtherObject2->new(id => 7, name => 'seven'), ); $o->other2_objs_on_save(@o2s); @o2s = $o->other2_objs_on_save; ok(@o2s == 3, "set one to many on save 1 - $db_type"); ok($o2s[0]->id == 5 && $o2s[0]->pid == 222, "set one to many on save 2 - $db_type"); ok($o2s[1]->id == 6 && $o2s[1]->pid == 222, "set one to many on save 3 - $db_type"); ok($o2s[2]->id == 7 && $o2s[2]->pid == 222, "set one to many on save 4 - $db_type"); ok(!MyInformixOtherObject2->new(id => 5)->load(speculative => 1), "set one to many on save 5 - $db_type"); ok(!MyInformixOtherObject2->new(id => 6)->load(speculative => 1), "set one to many on save 6 - $db_type"); ok(!MyInformixOtherObject2->new(id => 7)->load(speculative => 1), "set one to many on save 7 - $db_type"); $o->save; @o2s = $o->other2_objs_on_save; ok(@o2s == 3, "set one to many on save 8 - $db_type"); ok($o2s[0]->id == 6 && $o2s[0]->pid == 222, "set one to many on save 9 - $db_type"); ok($o2s[1]->id == 7 && $o2s[1]->pid == 222, "set one to many on save 10 - $db_type"); ok($o2s[2]->id == 5 && $o2s[2]->pid == 222, "set one to many on save 11 - $db_type"); $o2 = MyInformixOtherObject2->new(id => 5)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many on save 12 - $db_type"); $o2 = MyInformixOtherObject2->new(id => 6)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many on save 13 - $db_type"); $o2 = MyInformixOtherObject2->new(id => 7)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many on save 14 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_other2 WHERE pid = 222'); $sth->execute; $count = $sth->fetchrow_array; is($count, 3, "set one to many on save 15 - $db_type"); # RESET $o = MyInformixObject->new(id => 222)->load; # Set (one existing, one new) @o2s = ( MyInformixOtherObject2->new(id => 7, name => 'seven'), MyInformixOtherObject2->new(id => 12, name => 'one'), ); ok($o->other2_objs_on_save(\@o2s), "set 2 one to many on save 1 - $db_type"); $o2 = MyInformixOtherObject2->new(id => 7)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many on save 2 - $db_type"); ok(!MyInformixOtherObject2->new(id => 12)->load(speculative => 1), "set 2 one to many on save 3 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_other2 WHERE pid = 222'); $sth->execute; $count = $sth->fetchrow_array; is($count, 3, "set 2 one to many on save 4 - $db_type"); @o2s = $o->other2_objs_on_save; ok(@o2s == 2, "set 2 one to many on save 5 - $db_type"); ok($o2s[0]->id == 7 && $o2s[0]->pid == 222, "set 2 one to many on save 6 - $db_type"); ok($o2s[1]->id == 12 && $o2s[1]->pid == 222, "set 2 one to many on save 7 - $db_type"); $o->save; @o2s = $o->other2_objs_on_save; ok(@o2s == 2, "set one to many on save 8 - $db_type"); ok($o2s[0]->id == 7 && $o2s[0]->pid == 222, "set 2 one to many on save 9 - $db_type"); ok($o2s[1]->id == 12 && $o2s[1]->pid == 222, "set 2 one to many on save 10 - $db_type"); $o2 = MyInformixOtherObject2->new(id => 7)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many on save 11 - $db_type"); $o2 = MyInformixOtherObject2->new(id => 12)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many on save 12 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_other2 WHERE pid = 222'); $sth->execute; $count = $sth->fetchrow_array; is($count, 2, "set one to many on save 15 - $db_type"); # Set to undef $o->other2_objs_on_save(undef); @o2s = $o->other2_objs_on_save; ok(@o2s == 2, "set one to many on save 16 - $db_type"); ok($o2s[0]->id == 7 && $o2s[0]->pid == 222, "set 2 one to many on save 17 - $db_type"); ok($o2s[1]->id == 12 && $o2s[1]->pid == 222, "set 2 one to many on save 18 - $db_type"); $o2 = MyInformixOtherObject2->new(id => 7)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many on save 19 - $db_type"); $o2 = MyInformixOtherObject2->new(id => 12)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many on save 20 - $db_type"); # # "one to many" add_now # # SETUP $o2->db->dbh->do('DELETE FROM rose_db_object_other2'); $o = MyInformixObject->new(id => 333, name => 'Zoom', flag => 1); $o->save; @o2s = ( MyInformixOtherObject2->new(id => 5, name => 'five'), MyInformixOtherObject2->new(id => 6, name => 'six'), MyInformixOtherObject2->new(id => 7, name => 'seven'), ); $o->other2_objs_now(@o2s); # RESET $o = MyInformixObject->new(id => 333, name => 'Zoom', flag => 1); # Add, no args @o2s = (); ok($o->add_other2_objs_now(@o2s) == 0, "add one to many now 1 - $db_type"); # Add before load/save @o2s = ( MyInformixOtherObject2->new(id => 8, name => 'eight'), ); eval { $o->add_other2_objs_now(@o2s) }; ok($@, "add one to many now 2 - $db_type"); # Add $o->load; $o->add_other2_objs_now(@o2s); @o2s = $o->other2_objs; ok(@o2s == 4, "add one to many now 3 - $db_type"); ok($o2s[0]->id == 6 && $o2s[0]->pid == 333, "add one to many now 4 - $db_type"); ok($o2s[1]->id == 7 && $o2s[1]->pid == 333, "add one to many now 5 - $db_type"); ok($o2s[2]->id == 5 && $o2s[2]->pid == 333, "add one to many now 6 - $db_type"); ok($o2s[3]->id == 8 && $o2s[3]->pid == 333, "add one to many now 7 - $db_type"); ok(MyInformixOtherObject2->new(id => 6)->load(speculative => 1), "add one to many now 8 - $db_type"); ok(MyInformixOtherObject2->new(id => 7)->load(speculative => 1), "add one to many now 9 - $db_type"); ok(MyInformixOtherObject2->new(id => 5)->load(speculative => 1), "add one to many now 10 - $db_type"); ok(MyInformixOtherObject2->new(id => 8)->load(speculative => 1), "add one to many now 11 - $db_type"); # # "one to many" add_on_save # # SETUP $o2->db->dbh->do('DELETE FROM rose_db_object_other2'); $o = MyInformixObject->new(id => 444, name => 'Blargh', flag => 1); # Set on save, add on save, save @o2s = ( MyInformixOtherObject2->new(id => 10, name => 'ten'), ); # Set on save $o->other2_objs_on_save(@o2s); @o2s = $o->other2_objs; ok(@o2s == 1, "add one to many on save 1 - $db_type"); ok($o2s[0]->id == 10 && $o2s[0]->pid == 444, "add one to many on save 2 - $db_type"); ok(!MyInformixOtherObject2->new(id => 10)->load(speculative => 1), "add one to many on save 3 - $db_type"); @o2s = ( MyInformixOtherObject2->new(id => 9, name => 'nine'), ); # Add on save ok($o->add_other2_objs(@o2s), "add one to many on save 4 - $db_type"); @o2s = $o->other2_objs; ok(@o2s == 2, "add one to many on save 5 - $db_type"); ok($o2s[0]->id == 10 && $o2s[0]->pid == 444, "add one to many on save 6 - $db_type"); ok($o2s[1]->id == 9 && $o2s[0]->pid == 444, "add one to many on save 7 - $db_type"); ok(!MyInformixOtherObject2->new(id => 10)->load(speculative => 1), "add one to many on save 8 - $db_type"); ok(!MyInformixOtherObject2->new(id => 9)->load(speculative => 1), "add one to many on save 9 - $db_type"); $o->save; @o2s = $o->other2_objs; ok(@o2s == 2, "add one to many on save 10 - $db_type"); ok($o2s[0]->id == 10 && $o2s[0]->pid == 444, "add one to many on save 11 - $db_type"); ok($o2s[1]->id == 9 && $o2s[1]->pid == 444, "add one to many on save 12 - $db_type"); ok(MyInformixOtherObject2->new(id => 10)->load(speculative => 1), "add one to many on save 13 - $db_type"); ok(MyInformixOtherObject2->new(id => 9)->load(speculative => 1), "add one to many on save 14 - $db_type"); # RESET $o = MyInformixObject->new(id => 444, name => 'Blargh', flag => 1); $o->load; # Add on save, save @o2s = ( MyInformixOtherObject2->new(id => 11, name => 'eleven'), ); # Add on save ok($o->add_other2_objs(\@o2s), "add one to many on save 15 - $db_type"); @o2s = $o->other2_objs; ok(@o2s == 2, "add one to many on save 16 - $db_type"); ok($o2s[0]->id == 10 && $o2s[0]->pid == 444, "add one to many on save 17 - $db_type"); ok($o2s[1]->id == 9 && $o2s[1]->pid == 444, "add one to many on save 18 - $db_type"); ok(MyInformixOtherObject2->new(id => 10)->load(speculative => 1), "add one to many on save 19 - $db_type"); ok(MyInformixOtherObject2->new(id => 9)->load(speculative => 1), "add one to many on save 20 - $db_type"); ok(!MyInformixOtherObject2->new(id => 11)->load(speculative => 1), "add one to many on save 21 - $db_type"); # Save $o->save; @o2s = $o->other2_objs; ok(@o2s == 3, "add one to many on save 22 - $db_type"); ok($o2s[0]->id == 10 && $o2s[0]->pid == 444, "add one to many on save 23 - $db_type"); ok($o2s[1]->id == 9 && $o2s[1]->pid == 444, "add one to many on save 24 - $db_type"); ok($o2s[2]->id == 11 && $o2s[2]->pid == 444, "add one to many on save 25 - $db_type"); ok(MyInformixOtherObject2->new(id => 10)->load(speculative => 1), "add one to many on save 26 - $db_type"); ok(MyInformixOtherObject2->new(id => 9)->load(speculative => 1), "add one to many on save 27 - $db_type"); ok(MyInformixOtherObject2->new(id => 11)->load(speculative => 1), "add one to many on save 28 - $db_type"); # End "one to many" method tests # Start "load with ..." tests ok($o = MyInformixObject->new(id => 444)->load(with => [ qw(other_obj other2_objs colors) ]), "load with 1 - $db_type"); ok($o->{'other2_objs'} && $o->{'other2_objs'}[1]->name eq 'nine', "load with 2 - $db_type"); $o = MyInformixObject->new(id => 999); ok(!$o->load(with => [ qw(other_obj other2_objs colors) ], speculative => 1), "load with 3 - $db_type"); $o = MyInformixObject->new(id => 222); ok($o->load(with => 'colors'), "load with 4 - $db_type"); # End "load with ..." tests # Start "many to many" tests # # "many to many" get_set_now # # SETUP $o = MyInformixObject->new(id => 30, name => 'Color', flag => 1); # Set @colors = ( 1, # red MyInformixColor->new(id => 3), # blue { id => 5, name => 'orange' }, ); #MyInformixColor->new(id => 2), # green #MyInformixColor->new(id => 4), # pink # Set before save, save, set eval { $o->colors_now(@colors) }; ok($@, "set many to many now 1 - $db_type"); $o->save; ok($o->colors_now(@colors), "set many to many now 2 - $db_type"); @colors = $o->colors_now; ok(@colors == 3, "set many to many now 3 - $db_type"); ok($colors[0]->id == 3, "set many to many now 4 - $db_type"); ok($colors[1]->id == 5, "set many to many now 5 - $db_type"); ok($colors[2]->id == 1, "set many to many now 6 - $db_type"); $color = MyInformixColor->new(id => 5); ok($color->load(speculative => 1), "set many to many now 7 - $db_type"); ok(MyInformixColorMap->new(obj_id => 30, color_id => 3)->load(speculative => 1), "set many to many now 8 - $db_type"); ok(MyInformixColorMap->new(obj_id => 30, color_id => 5)->load(speculative => 1), "set many to many now 9 - $db_type"); ok(MyInformixColorMap->new(obj_id => 30, color_id => 1)->load(speculative => 1), "set many to many now 10 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 30'); $sth->execute; $count = $sth->fetchrow_array; is($count, 3, "set many to many now 11 - $db_type"); # Set to undef $o->colors_now(undef); @colors = $o->colors_now; ok(@colors == 3, "set 2 many to many now 1 - $db_type"); ok($colors[0]->id == 3, "set 2 many to many now 2 - $db_type"); ok($colors[1]->id == 5, "set 2 many to many now 3 - $db_type"); ok($colors[2]->id == 1, "set 2 many to many now 4 - $db_type"); $color = MyInformixColor->new(id => 5); ok($color->load(speculative => 1), "set 2 many to many now 5 - $db_type"); $color = MyInformixColor->new(id => 3); ok($color->load(speculative => 1), "set 2 many to many now 6 - $db_type"); $color = MyInformixColor->new(id => 1); ok($color->load(speculative => 1), "set 2 many to many now 7 - $db_type"); ok(MyInformixColorMap->new(obj_id => 30, color_id => 3)->load(speculative => 1), "set 2 many to many now 8 - $db_type"); ok(MyInformixColorMap->new(obj_id => 30, color_id => 5)->load(speculative => 1), "set 2 many to many now 9 - $db_type"); ok(MyInformixColorMap->new(obj_id => 30, color_id => 1)->load(speculative => 1), "set 2 many to many now 10 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 30'); $sth->execute; $count = $sth->fetchrow_array; is($count, 3, "set 2 many to many now 11 - $db_type"); # # "many to many" get_set_on_save # # SETUP $o = MyInformixObject->new(id => 40, name => 'Cool', flag => 1); # Set @colors = ( MyInformixColor->new(id => 1), # red 3, # blue { id => 6, name => 'ochre' }, ); #MyInformixColor->new(id => 2), # green #MyInformixColor->new(id => 4), # pink $o->colors_on_save(@colors); @colors = $o->colors_on_save; ok(@colors == 3, "set many to many on save 1 - $db_type"); ok($colors[0]->id == 1, "set many to many on save 2 - $db_type"); ok($colors[1]->id == 3, "set many to many on save 3 - $db_type"); ok($colors[2]->id == 6, "set many to many on save 4 - $db_type"); ok(MyInformixColor->new(id => 1)->load(speculative => 1), "set many to many on save 5 - $db_type"); ok(MyInformixColor->new(id => 3)->load(speculative => 1), "set many to many on save 6 - $db_type"); ok(!MyInformixColor->new(id => 6)->load(speculative => 1), "set many to many on save 7 - $db_type"); ok(!MyInformixColorMap->new(obj_id => 40, color_id => 1)->load(speculative => 1), "set many to many on save 8 - $db_type"); ok(!MyInformixColorMap->new(obj_id => 40, color_id => 3)->load(speculative => 1), "set many to many on save 9 - $db_type"); ok(!MyInformixColorMap->new(obj_id => 40, color_id => 6)->load(speculative => 1), "set many to many on save 10 - $db_type"); $o->save; @colors = $o->colors_on_save; ok(@colors == 3, "set many to many on save 11 - $db_type"); ok($colors[0]->id == 3, "set many to many on save 12 - $db_type"); ok($colors[1]->id == 6, "set many to many on save 13 - $db_type"); ok($colors[2]->id == 1, "set many to many on save 14 - $db_type"); ok(MyInformixColor->new(id => 1)->load(speculative => 1), "set many to many on save 15 - $db_type"); ok(MyInformixColor->new(id => 3)->load(speculative => 1), "set many to many on save 16 - $db_type"); ok(MyInformixColor->new(id => 6)->load(speculative => 1), "set many to many on save 17 - $db_type"); ok(MyInformixColorMap->new(obj_id => 40, color_id => 1)->load(speculative => 1), "set 2 many to many on save 18 - $db_type"); ok(MyInformixColorMap->new(obj_id => 40, color_id => 3)->load(speculative => 1), "set 2 many to many on save 19 - $db_type"); ok(MyInformixColorMap->new(obj_id => 40, color_id => 6)->load(speculative => 1), "set 2 many to many on save 20 - $db_type"); $sth = $color->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 40'); $sth->execute; $count = $sth->fetchrow_array; is($count, 3, "set many to many on save 21 - $db_type"); # RESET $o = MyInformixObject->new(id => 40)->load; # Set to undef $o->colors_on_save(undef); @colors = $o->colors_on_save; ok(@colors == 3, "set 2 many to many on save 1 - $db_type"); ok($colors[0]->id == 3, "set 2 many to many on save 2 - $db_type"); ok($colors[1]->id == 6, "set 2 many to many on save 3 - $db_type"); ok($colors[2]->id == 1, "set 2 many to many on save 4 - $db_type"); ok(MyInformixColor->new(id => 1)->load(speculative => 1), "set 2 many to many on save 5 - $db_type"); ok(MyInformixColor->new(id => 3)->load(speculative => 1), "set 2 many to many on save 6 - $db_type"); ok(MyInformixColor->new(id => 6)->load(speculative => 1), "set 2 many to many on save 7 - $db_type"); ok(MyInformixColorMap->new(obj_id => 40, color_id => 1)->load(speculative => 1), "set 2 many to many on save 8 - $db_type"); ok(MyInformixColorMap->new(obj_id => 40, color_id => 3)->load(speculative => 1), "set 2 many to many on save 9 - $db_type"); ok(MyInformixColorMap->new(obj_id => 40, color_id => 6)->load(speculative => 1), "set 2 many to many on save 10 - $db_type"); $sth = $color->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 40'); $sth->execute; $count = $sth->fetchrow_array; is($count, 3, "set 2 many to many on save 11 - $db_type"); $o->colors([]); $o->save(changes_only => 1); $o->colors_on_save({ id => 1, name => 'redx' }, { id => 3 }); $o->save(changes_only => 1); $o->colors_on_save(undef); $colors = $o->colors_on_save; ok(ref $colors eq 'ARRAY' && @$colors == 2 && $colors->[0]->name eq 'blue' && $colors->[1]->name eq 'redx', "colors merge 1 - $db_type"); $o->colors_on_save({ id => 2 }, { id => 3, name => 'bluex' }); $o->save(changes_only => 1); $o->colors_on_save(undef); $colors = $o->colors_on_save; ok(ref $colors eq 'ARRAY' && @$colors == 2 && $colors->[0]->name eq 'bluex' && $colors->[1]->name eq 'green', "colors merge 2 - $db_type"); # # "many to many" add_now # # SETUP $o = MyInformixObject->new(id => 50, name => 'Blat', flag => 1); $o->delete; @colors = ( MyInformixColor->new(id => 1), # red MyInformixColor->new(id => 3), # blue ); #MyInformixColor->new(id => 4), # pink $o->colors_on_save(\@colors); $o->save; $o = MyInformixObject->new(id => 50, name => 'Blat', flag => 1); # Add, no args @colors = (); ok($o->add_colors(@colors) == 0, "add many to many now 1 - $db_type"); # Add before load/save @colors = ( MyInformixColor->new(id => 7, name => 'puce'), MyInformixColor->new(id => 2), # green ); eval { $o->add_colors(@colors) }; ok($@, "add many to many now 2 - $db_type"); # Add $o->load; $o->add_colors(@colors); @colors = $o->colors; ok(@colors == 4, "add many to many now 3 - $db_type"); ok($colors[0]->id == 3, "add many to many now 4 - $db_type"); ok($colors[1]->id == 2, "add many to many now 5 - $db_type"); ok($colors[2]->id == 7, "add many to many now 6 - $db_type"); ok($colors[3]->id == 1, "add many to many now 7 - $db_type"); ok(MyInformixColor->new(id => 3)->load(speculative => 1), "add many to many now 8 - $db_type"); ok(MyInformixColor->new(id => 2)->load(speculative => 1), "add many to many now 9 - $db_type"); ok(MyInformixColor->new(id => 7)->load(speculative => 1), "add many to many now 10 - $db_type"); ok(MyInformixColor->new(id => 1)->load(speculative => 1), "add many to many now 11 - $db_type"); ok(MyInformixColorMap->new(obj_id => 50, color_id => 3)->load(speculative => 1), "set 2 many to many on save 12 - $db_type"); ok(MyInformixColorMap->new(obj_id => 50, color_id => 2)->load(speculative => 1), "set 2 many to many on save 13 - $db_type"); ok(MyInformixColorMap->new(obj_id => 50, color_id => 7)->load(speculative => 1), "set 2 many to many on save 14 - $db_type"); ok(MyInformixColorMap->new(obj_id => 50, color_id => 1)->load(speculative => 1), "set 2 many to many on save 15 - $db_type"); # # "many to many" add_on_save # # SETUP $o = MyInformixObject->new(id => 60, name => 'Cretch', flag => 1); $o->delete; # Set on save, add on save, save @colors = ( MyInformixColor->new(id => 1), # red MyInformixColor->new(id => 2), # green ); # Set on save $o->colors_on_save(@colors); @colors = ( MyInformixColor->new(id => 7), # puce MyInformixColor->new(id => 8, name => 'tan'), ); # Add on save ok($o->add_colors_on_save(@colors), "add many to many on save 1 - $db_type"); @colors = $o->colors; ok(@colors == 4, "add many to many on save 2 - $db_type"); ok($colors[0]->id == 1, "add many to many on save 3 - $db_type"); ok($colors[1]->id == 2, "add many to many on save 4 - $db_type"); ok($colors[2]->id == 7, "add many to many on save 5 - $db_type"); ok($colors[3]->id == 8, "add many to many on save 6 - $db_type"); ok(MyInformixColor->new(id => 1)->load(speculative => 1), "add many to many on save 7 - $db_type"); ok(MyInformixColor->new(id => 2)->load(speculative => 1), "add many to many on save 8 - $db_type"); ok(MyInformixColor->new(id => 7)->load(speculative => 1), "add many to many on save 9 - $db_type"); ok(!MyInformixColor->new(id => 8)->load(speculative => 1), "add many to many on save 10 - $db_type"); ok(!MyInformixColorMap->new(obj_id => 60, color_id => 1)->load(speculative => 1), "set many to many on save 11 - $db_type"); ok(!MyInformixColorMap->new(obj_id => 60, color_id => 2)->load(speculative => 1), "set many to many on save 12 - $db_type"); ok(!MyInformixColorMap->new(obj_id => 60, color_id => 7)->load(speculative => 1), "set many to many on save 13 - $db_type"); ok(!MyInformixColorMap->new(obj_id => 60, color_id => 8)->load(speculative => 1), "set many to many on save 14 - $db_type"); $o->save; @colors = $o->colors; ok(@colors == 4, "add many to many on save 15 - $db_type"); ok($colors[0]->id == 2, "add many to many on save 16 - $db_type"); ok($colors[1]->id == 7, "add many to many on save 17 - $db_type"); ok($colors[2]->id == 1, "add many to many on save 18 - $db_type"); ok($colors[3]->id == 8, "add many to many on save 19 - $db_type"); ok(MyInformixColor->new(id => 2)->load(speculative => 1), "add many to many on save 20 - $db_type"); ok(MyInformixColor->new(id => 7)->load(speculative => 1), "add many to many on save 21 - $db_type"); ok(MyInformixColor->new(id => 1)->load(speculative => 1), "add many to many on save 22 - $db_type"); ok(MyInformixColor->new(id => 8)->load(speculative => 1), "add many to many on save 21 - $db_type"); ok(MyInformixColorMap->new(obj_id => 60, color_id => 2)->load(speculative => 1), "add many to many on save 22 - $db_type"); ok(MyInformixColorMap->new(obj_id => 60, color_id => 7)->load(speculative => 1), "add many to many on save 23 - $db_type"); ok(MyInformixColorMap->new(obj_id => 60, color_id => 1)->load(speculative => 1), "add many to many on save 24 - $db_type"); ok(MyInformixColorMap->new(obj_id => 60, color_id => 8)->load(speculative => 1), "add many to many on save 25 - $db_type"); $sth = $color->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 60'); $sth->execute; $count = $sth->fetchrow_array; is($count, 4, "add many to many on save 26 - $db_type"); # RESET $o = MyInformixObject->new(id => 60, name => 'Cretch', flag => 1); $o->load(with => 'colors'); # Add on save, save @colors = ( MyInformixColor->new(id => 9, name => 'aqua'), ); # Add on save ok($o->add_colors_on_save(@colors), "add 2 many to many on save 1 - $db_type"); @colors = $o->colors; ok(@colors == 5, "add 2 many to many on save 16 - $db_type"); ok($colors[0]->id == 2, "add 2 many to many on save 2 - $db_type"); ok($colors[1]->id == 7, "add 2 many to many on save 3 - $db_type"); ok($colors[2]->id == 1, "add 2 many to many on save 4 - $db_type"); ok($colors[3]->id == 8, "add 2 many to many on save 5 - $db_type"); ok($colors[4]->id == 9, "add 2 many to many on save 6 - $db_type"); ok(MyInformixColor->new(id => 2)->load(speculative => 1), "add many to many on save 7 - $db_type"); ok(MyInformixColor->new(id => 7)->load(speculative => 1), "add many to many on save 8 - $db_type"); ok(MyInformixColor->new(id => 1)->load(speculative => 1), "add many to many on save 9 - $db_type"); ok(MyInformixColor->new(id => 8)->load(speculative => 1), "add many to many on save 10 - $db_type"); ok(!MyInformixColor->new(id => 9)->load(speculative => 1), "add many to many on save 11 - $db_type"); ok(MyInformixColorMap->new(obj_id => 60, color_id => 2)->load(speculative => 1), "add 2 many to many on save 12 - $db_type"); ok(MyInformixColorMap->new(obj_id => 60, color_id => 7)->load(speculative => 1), "add 2 many to many on save 13 - $db_type"); ok(MyInformixColorMap->new(obj_id => 60, color_id => 1)->load(speculative => 1), "add 2 many to many on save 14 - $db_type"); ok(MyInformixColorMap->new(obj_id => 60, color_id => 8)->load(speculative => 1), "add 2 many to many on save 15 - $db_type"); ok(!MyInformixColorMap->new(obj_id => 60, color_id => 9)->load(speculative => 1), "add 2 many to many on save 16 - $db_type"); $sth = $color->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 60'); $sth->execute; $count = $sth->fetchrow_array; is($count, 4, "add 2 many to many on save 17 - $db_type"); # Save $o->save; @colors = $o->colors; ok(@colors == 5, "add 2 many to many on save 18 - $db_type"); ok($colors[0]->id == 9, "add 2 many to many on save 19 - $db_type"); ok($colors[1]->id == 2, "add 2 many to many on save 20 - $db_type"); ok($colors[2]->id == 7, "add 2 many to many on save 21 - $db_type"); ok($colors[3]->id == 1, "add 2 many to many on save 22 - $db_type"); ok($colors[4]->id == 8, "add 2 many to many on save 23 - $db_type"); ok(MyInformixColor->new(id => 9)->load(speculative => 1), "add many to many on save 24 - $db_type"); ok(MyInformixColor->new(id => 2)->load(speculative => 1), "add many to many on save 25 - $db_type"); ok(MyInformixColor->new(id => 7)->load(speculative => 1), "add many to many on save 26 - $db_type"); ok(MyInformixColor->new(id => 1)->load(speculative => 1), "add many to many on save 27 - $db_type"); ok(MyInformixColor->new(id => 8)->load(speculative => 1), "add many to many on save 28 - $db_type"); ok(MyInformixColorMap->new(obj_id => 60, color_id => 9)->load(speculative => 1), "add 2 many to many on save 29 - $db_type"); ok(MyInformixColorMap->new(obj_id => 60, color_id => 2)->load(speculative => 1), "add 2 many to many on save 20 - $db_type"); ok(MyInformixColorMap->new(obj_id => 60, color_id => 7)->load(speculative => 1), "add 2 many to many on save 31 - $db_type"); ok(MyInformixColorMap->new(obj_id => 60, color_id => 1)->load(speculative => 1), "add 2 many to many on save 32 - $db_type"); ok(MyInformixColorMap->new(obj_id => 60, color_id => 8)->load(speculative => 1), "add 2 many to many on save 33 - $db_type"); $sth = $color->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 60'); $sth->execute; $count = $sth->fetchrow_array; $sth->finish; is($count, 5, "add 2 many to many on save 34 - $db_type"); # End "many to many" tests } # # SQLite # SKIP: foreach my $db_type ('sqlite') { skip("SQLite tests", 465) unless($HAVE_SQLITE); Rose::DB->default_type($db_type); my $o = MySQLiteObject->new(name => 'John', id => 1); ok(ref $o && $o->isa('MySQLiteObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(7); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); my $o_x = MySQLiteObject->new(id => 99, name => 'John X', flag => 0); $o_x->save; my $o2 = MySQLiteObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MySQLiteObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 7, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MySQLiteObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MySQLiteObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->load, "load() 4 - $db_type"); my $o5 = MySQLiteObject->new(id => $o->id); ok($o5->load, "load() 5 - $db_type"); $o5->nums([ 4, 5, 6 ]); ok($o5->save, "save() 4 - $db_type"); ok($o->load, "load() 6 - $db_type"); is($o5->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o5->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o5->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o5->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); my $oo1 = MySQLiteOtherObject->new(k1 => 1, k2 => 2, k3 => 3, name => 'one'); ok($oo1->save, "other object save() 1 - $db_type"); my $oo2 = MySQLiteOtherObject->new(k1 => 11, k2 => 12, k3 => 13, name => 'two'); ok($oo2->save, "other object save() 2 - $db_type"); is($o->other_obj, undef, "other_obj() 1 - $db_type"); $o->fkone(99); $o->fk2(99); $o->fk3(99); eval { $o->other_obj }; ok($@, "fatal referential_integrity - $db_type"); ok(!defined $o->other_obj_osoft, "ok referential_integrity 1 - $db_type"); ok(!defined $o->other_obj_msoft, "ok referential_integrity 2 - $db_type"); $o->fkone(1); $o->fk2(2); $o->fk3(3); my $obj = $o->other_obj or warn "# ", $o->error, "\n"; is(ref $obj, 'MySQLiteOtherObject', "other_obj() 2 - $db_type"); is($obj->name, 'one', "other_obj() 3 - $db_type"); $o->other_obj(undef); $o->fkone(11); $o->fk2(12); $o->fk3(13); ok(!$o->has_loaded_related('other_obj'), "has_loaded_related() 1 - $db_type"); $obj = $o->other_obj or warn "# ", $o->error, "\n"; ok($o->has_loaded_related('other_obj'), "has_loaded_related() 2 - $db_type"); is(ref $obj, 'MySQLiteOtherObject', "other_obj() 4 - $db_type"); is($obj->name, 'two', "other_obj() 5 - $db_type"); my $oo21 = MySQLiteOtherObject2->new(id => 1, name => 'one', pid => $o->id); ok($oo21->save, "other object 2 save() 1 - $db_type"); my $oo22 = MySQLiteOtherObject2->new(id => 2, name => 'two', pid => $o->id); ok($oo22->save, "other object 2 save() 2 - $db_type"); my $oo23 = MySQLiteOtherObject2->new(id => 3, name => 'three', pid => $o_x->id); ok($oo23->save, "other object 2 save() 3 - $db_type"); # Begin experiment #local $Rose::DB::Object::Manager::Debug = 1; my $no2s = $o->not_other2_objs; is(scalar @$no2s, 2, "not equal one-to-many 1 - $db_type"); my $nobjs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', require_objects => [ 'not_other2_objs' ]); is(scalar @$nobjs, 2, "not equal one-to-many 2 - $db_type"); MySQLiteObject->meta->delete_relationship('not_other2_objs'); # End experiment # Begin manager_*_method tests my $manager_method_obj = MySQLiteObject->new(id => $o->id)->load; is($manager_method_obj->custom_manager_method_other2_objs, 'ima-get-objects', "custom manager method ima-get-objects - $db_type"); is($manager_method_obj->meta->relationship('custom_manager_method_other_obj_msoft')->manager_delete_method, 'other_obj_delete', "custom manager method ima-delete - $db_type"); is($manager_method_obj->find_custom_manager_method_other2_objs, 'ima-find', "custom manager method ima-find - $db_type"); is($manager_method_obj->custom_manager_method_other2_objs_iterator, 'ima-iterator', "custom manager method ima-iterator - $db_type"); is($manager_method_obj->custom_manager_method_other2_objs_count, 'ima-count', "custom manager method ima-count - $db_type"); # End manager_*_method tests # Begin filtered collection tests my $x = MySQLiteObject->new(id => $o->id)->load; $x->other2_a_objs({ name => 'aoo' }, { name => 'abc' }); $x->save; $x = MySQLiteObject->new(id => $o->id)->load; my $one_o = $x->other2_one_obj; my $ao = $x->other2_a_objs; my $oo = $x->other2_objs; is($one_o->id, 1, "filtered one-to-one 1 - $db_type"); is(scalar @$ao, 2, "filtered one-to-many 1 - $db_type"); is(join(',', map { $_->name } @$ao), 'abc,aoo', "filtered one-to-many 2 - $db_type"); is(scalar @$oo, 4, "filtered one-to-many 3 - $db_type"); is(join(',', sort map { $_->name } @$oo), 'abc,aoo,one,two', "filtered one-to-many 4 - $db_type"); $x->other2_a_objs({ name => 'axx' }); $x->save; $x = MySQLiteObject->new(id => $o->id)->load; $ao = $x->other2_a_objs; $oo = $x->other2_objs; is(scalar @$ao, 1, "filtered one-to-many 5 - $db_type"); is(join(',', map { $_->name } @$ao), 'axx', "filtered one-to-many 6 - $db_type"); is(scalar @$oo, 3, "filtered one-to-many 7 - $db_type"); is(join(',', sort map { $_->name } @$oo), 'axx,one,two', "filtered one-to-many 8 - $db_type"); $x->other2_a_objs([]); $x->save; # End filtered collection tests ok(!$o->has_loaded_related('other2_objs'), "has_loaded_related() 3 - $db_type"); my $o2s = $o->other2_objs; ok($o->has_loaded_related('other2_objs'), "has_loaded_related() 4 - $db_type"); ok(ref $o2s eq 'ARRAY' && @$o2s == 2 && $o2s->[0]->name eq 'two' && $o2s->[1]->name eq 'one', 'other objects 1'); my @o2s = $o->other2_objs; ok(@o2s == 2 && $o2s[0]->name eq 'two' && $o2s[1]->name eq 'one', 'other objects 2'); my $color = MySQLiteColor->new(id => 1, name => 'red'); ok($color->save, "save color 1 - $db_type"); $color = MySQLiteColor->new(id => 2, name => 'green'); ok($color->save, "save color 2 - $db_type"); $color = MySQLiteColor->new(id => 3, name => 'blue'); ok($color->save, "save color 3 - $db_type"); $color = MySQLiteColor->new(id => 4, name => 'pink'); ok($color->save, "save color 4 - $db_type"); my $map1 = MySQLiteColorMap->new(obj_id => 1, color_id => 1); ok($map1->save, "save color map record 1 - $db_type"); my $map2 = MySQLiteColorMap->new(obj_id => 1, color_id => 3); ok($map2->save, "save color map record 2 - $db_type"); my $map3 = MySQLiteColorMap->new(obj_id => 99, color_id => 4); ok($map3->save, "save color map record 3 - $db_type"); my $colors = $o->colors; ok(ref $colors eq 'ARRAY' && @$colors == 2 && $colors->[0]->name eq 'blue' && $colors->[1]->name eq 'red', "colors 1 - $db_type"); $colors = $o->find_colors; ok(ref $colors eq 'ARRAY' && @$colors == 2 && $colors->[0]->name eq 'blue' && $colors->[1]->name eq 'red', "find colors 1 - $db_type"); $colors = $o->find_colors([ name => { like => 'r%' } ]); ok(ref $colors eq 'ARRAY' && @$colors == 1 && $colors->[0]->name eq 'red', "find colors 2 - $db_type"); $colors = $o->find_colors(query => [ name => { like => 'r%' } ], cache => 1); my $colors2 = $o->find_colors(from_cache => 1); ok(ref $colors eq 'ARRAY' && @$colors == 1 && $colors->[0]->name eq 'red' && ref $colors2 eq 'ARRAY' && @$colors2 == 1 && $colors2->[0]->name eq 'red' && $colors->[0] eq $colors2->[0], "find colors from cache - $db_type"); ok(my $iterator = $o->colors_iterator, "get colors_iterator - $db_type"); ok($iterator->isa('Rose::DB::Object::Iterator'), "colors iterator isa Iterator - $db_type"); while(my $color = $iterator->next) { ok($color->name, "color has a name (" . $color->name . ") - $db_type"); } is($iterator->total, 2, "iterator total - $db_type"); my $count = $o->colors_count; is($count, 2, "count colors 1 - $db_type"); $count = $o->colors_count([ name => { like => 'r%' } ]); is($count, 1, "count colors 2 - $db_type"); my @colors = $o->colors; ok(@colors == 2 && $colors[0]->name eq 'blue' && $colors[1]->name eq 'red', "colors 2 - $db_type"); $colors = $o_x->colors; ok(ref $colors eq 'ARRAY' && @$colors == 1 && $colors->[0]->name eq 'pink', "colors 3 - $db_type"); @colors = $o_x->colors; ok(@colors == 1 && $colors[0]->name eq 'pink', "colors 4 - $db_type"); $o = MySQLiteObject->new(id => 1)->load; $o->fkone(1); $o->fk2(2); $o->fk3(3); $o->save; #local $Rose::DB::Object::Manager::Debug = 1; eval { local $o->dbh->{'PrintError'} = 0; $o->delete(cascade => 'null'); }; ok($@, "delete cascade null 1 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( db => $o->db, object_class => 'MySQLiteOtherObject'); is($count, 2, "delete cascade rollback confirm 1 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( db => $o->db, object_class => 'MySQLiteOtherObject2'); is($count, 3, "delete cascade rollback confirm 2 - $db_type"); ok($o->delete(cascade => 'delete'), "delete cascade delete 1 - $db_type"); $o = MySQLiteObject->new(id => 99)->load; $o->fkone(11); $o->fk2(12); $o->fk3(13); $o->save; eval { local $o->dbh->{'PrintError'} = 0; $o->delete(cascade => 'null'); }; ok($@, "delete cascade null 2 - $db_type"); ok($o->delete(cascade => 'delete'), "delete cascade delete 2 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( db => $o->db, object_class => 'MySQLiteColorMap'); is($count, 0, "delete cascade confirm 1 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( db => $o->db, object_class => 'MySQLiteOtherObject2'); is($count, 0, "delete cascade confirm 2 - $db_type"); $count = Rose::DB::Object::Manager->get_objects_count( db => $o->db, object_class => 'MySQLiteOtherObject'); is($count, 0, "delete cascade confirm 3 - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, "alias_column() nonesuch - $db_type"); # Start foreign key method tests # # Foreign key get_set_now # $o = MySQLiteObject->new(id => 50, name => 'Alex', flag => 1); eval { $o->other_obj('abc') }; ok($@, "set foreign key object: one arg - $db_type"); eval { $o->other_obj(k1 => 1, k2 => 2, k3 => 3) }; ok($@, "set foreign key object: no save - $db_type"); $o->save; eval { local $o->db->dbh->{'PrintError'} = 0; $o->other_obj(k1 => 1, k2 => 2); }; ok($@, "set foreign key object: too few keys - $db_type"); ok($o->other_obj(k1 => 1, k2 => 2, k3 => 3), "set foreign key object 1 - $db_type"); ok($o->fkone == 1 && $o->fk2 == 2 && $o->fk3 == 3, "set foreign key object check keys 1 - $db_type"); ok($o->other_obj(k1 => 1, k2 => 2, k3 => 3), "set foreign key object 2 - $db_type"); ok($o->fkone == 1 && $o->fk2 == 2 && $o->fk3 == 3, "set foreign key object check keys 2 - $db_type"); # # Foreign key delete_now # ok($o->delete_other_obj, "delete foreign key object 1 - $db_type"); ok(!defined $o->fkone && !defined $o->fk2 && !defined $o->fk3, "delete foreign key object check keys 1 - $db_type"); ok(!defined $o->other_obj && defined $o->error, "delete foreign key object confirm 1 - $db_type"); ok(!defined $o->delete_other_obj, "delete foreign key object 2 - $db_type"); # # Foreign key get_set_on_save # # TEST: Set, save $o = MySQLiteObject->new(id => 100, name => 'Bub', flag => 1); ok($o->other_obj_on_save(k1 => 21, k2 => 22, k3 => 23), "set foreign key object on save 1 - $db_type"); my $co = MySQLiteObject->new(id => 100); ok(!$co->load(speculative => 1), "set foreign key object on save 2 - $db_type"); my $other_obj = $o->other_obj_on_save; ok($other_obj && $other_obj->k1 == 21 && $other_obj->k2 == 22 && $other_obj->k3 == 23, "set foreign key object on save 3 - $db_type"); ok($o->save, "set foreign key object on save 4 - $db_type"); $o = MySQLiteObject->new(id => 100); $o->load; $other_obj = $o->other_obj_on_save; ok($other_obj && $other_obj && $other_obj->k1 == 21 && $other_obj->k2 == 22 && $other_obj->k3 == 23, "set foreign key object on save 5 - $db_type"); # TEST: Set, set to undef, save $o = MySQLiteObject->new(id => 200, name => 'Rose', flag => 1); ok($o->other_obj_on_save(k1 => 51, k2 => 52, k3 => 53), "set foreign key object on save 6 - $db_type"); $co = MySQLiteObject->new(id => 200); ok(!$co->load(speculative => 1), "set foreign key object on save 7 - $db_type"); $other_obj = $o->other_obj_on_save; ok($other_obj && $other_obj->k1 == 51 && $other_obj->k2 == 52 && $other_obj->k3 == 53, "set foreign key object on save 8 - $db_type"); $o->other_obj_on_save(undef); ok($o->save, "set foreign key object on save 9 - $db_type"); $o = MySQLiteObject->new(id => 200); $o->load; ok(!defined $o->other_obj_on_save, "set foreign key object on save 10 - $db_type"); $co = MySQLiteOtherObject->new(k1 => 51, k2 => 52, k3 => 53); ok(!$co->load(speculative => 1), "set foreign key object on save 11 - $db_type"); $o->delete(cascade => 1); # TEST: Set, delete, save $o = MySQLiteObject->new(id => 200, name => 'Rose', flag => 1); ok($o->other_obj_on_save(k1 => 51, k2 => 52, k3 => 53), "set foreign key object on save 12 - $db_type"); $co = MySQLiteObject->new(id => 200); ok(!$co->load(speculative => 1), "set foreign key object on save 13 - $db_type"); $other_obj = $o->other_obj_on_save; ok($other_obj && $other_obj->k1 == 51 && $other_obj->k2 == 52 && $other_obj->k3 == 53, "set foreign key object on save 14 - $db_type"); ok($o->delete_other_obj, "set foreign key object on save 15 - $db_type"); $other_obj = $o->other_obj_on_save; ok(!defined $other_obj && !defined $o->fkone && !defined $o->fk2 && !defined $o->fk3, "set foreign key object on save 16 - $db_type"); ok($o->save, "set foreign key object on save 17 - $db_type"); $o = MySQLiteObject->new(id => 200); $o->load; ok(!defined $o->other_obj_on_save, "set foreign key object on save 18 - $db_type"); $co = MySQLiteOtherObject->new(k1 => 51, k2 => 52, k3 => 53); ok(!$co->load(speculative => 1), "set foreign key object on save 19 - $db_type"); $o->delete(cascade => 1); # # Foreign key delete_on_save # $o = MySQLiteObject->new(id => 500, name => 'Kip', flag => 1); $o->other_obj_on_save(k1 => 7, k2 => 8, k3 => 9); $o->save; $o = MySQLiteObject->new(id => 500); $o->load; # TEST: Delete, save $o->del_other_obj_on_save; $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are undef... ok(!defined $other_obj && !defined $o->fkone && !defined $o->fk2 && !defined $o->fk3, "delete foreign key object on save 1 - $db_type"); # ...but that the foreign object has not yet been deleted $co = MySQLiteOtherObject->new(k1 => 7, k2 => 8, k3 => 9); ok($co->load(speculative => 1), "delete foreign key object on save 2 - $db_type"); # Do the save ok($o->save, "delete foreign key object on save 3 - $db_type"); # Now it's deleted $co = MySQLiteOtherObject->new(k1 => 7, k2 => 8, k3 => 9); ok(!$co->load(speculative => 1), "delete foreign key object on save 4 - $db_type"); $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are undef ok(!defined $other_obj && !defined $o->fkone && !defined $o->fk2 && !defined $o->fk3, "delete foreign key object on save 5 - $db_type"); # RESET $o->delete; $o = MySQLiteObject->new(id => 700, name => 'Ham', flag => 0); $o->other_obj_on_save(k1 => 12, k2 => 34, k3 => 56); $o->save; $o = MySQLiteObject->new(id => 700); $o->load; # TEST: Delete, set on save, delete, save ok($o->del_other_obj_on_save, "delete 2 foreign key object on save 1 - $db_type"); $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are undef... ok(!defined $other_obj && !defined $o->fkone && !defined $o->fk2 && !defined $o->fk3, "delete 2 foreign key object on save 2 - $db_type"); # ...but that the foreign object has not yet been deleted $co = MySQLiteOtherObject->new(k1 => 12, k2 => 34, k3 => 56); ok($co->load(speculative => 1), "delete 3 foreign key object on save 3 - $db_type"); # Set on save $o->other_obj_on_save(k1 => 44, k2 => 55, k3 => 66); $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are set... ok($other_obj && $other_obj->k1 == 44 && $other_obj->k2 == 55 && $other_obj->k3 == 66, "delete 2 foreign key object on save 4 - $db_type"); # ...and that the foreign object has not yet been saved $co = MySQLiteOtherObject->new(k1 => 44, k2 => 55, k3 => 66); ok(!$co->load(speculative => 1), "delete 2 foreign key object on save 5 - $db_type"); # Delete again ok($o->del_other_obj_on_save, "delete 2 foreign key object on save 6 - $db_type"); $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are undef... ok(!defined $other_obj && !defined $o->fkone && !defined $o->fk2 && !defined $o->fk3, "delete 2 foreign key object on save 7 - $db_type"); # Confirm that the foreign objects have not been saved $co = MySQLiteOtherObject->new(k1 => 7, k2 => 8, k3 => 9); ok(!$co->load(speculative => 1), "delete 2 foreign key object on save 8 - $db_type"); $co = MySQLiteOtherObject->new(k1 => 44, k2 => 55, k3 => 66); ok(!$co->load(speculative => 1), "delete 2 foreign key object on save 9 - $db_type"); # RESET $o->delete; $o = MySQLiteObject->new(id => 800, name => 'Lee', flag => 1); $o->other_obj_on_save(k1 => 12, k2 => 34, k3 => 56); $o->save; $o = MySQLiteObject->new(id => 800); $o->load; # TEST: Set & save, delete on save, set on save, delete on save, save ok($o->other_obj(k1 => 1, k2 => 2, k3 => 3), "delete 3 foreign key object on save 1 - $db_type"); # Confirm that both foreign objects are in the db $co = MySQLiteOtherObject->new(k1 => 12, k2 => 34, k3 => 56); ok($co->load(speculative => 1), "delete 3 foreign key object on save 2 - $db_type"); $co = MySQLiteOtherObject->new(k1 => 1, k2 => 2, k3 => 3); ok($co->load(speculative => 1), "delete 3 foreign key object on save 3 - $db_type"); # Delete on save $o->del_other_obj_on_save; # Set-on-save to old value $o->other_obj_on_save(k1 => 12, k2 => 34, k3 => 56); # Delete on save $o->del_other_obj_on_save; # Save $o->save; # Confirm that both foreign objects have been deleted $co = MySQLiteOtherObject->new(k1 => 12, k2 => 34, k3 => 56); ok(!$co->load(speculative => 1), "delete 3 foreign key object on save 4 - $db_type"); $co = MySQLiteOtherObject->new(k1 => 1, k2 => 2, k3 => 3); ok(!$co->load(speculative => 1), "delete 3 foreign key object on save 5 - $db_type"); # RESET $o->delete; $o = MySQLiteObject->new(id => 900, name => 'Kai', flag => 1); $o->other_obj_on_save(k1 => 12, k2 => 34, k3 => 56); $o->save; $o = MySQLiteObject->new(id => 900); $o->load; # TEST: Delete on save, set on save, delete on save, set to same one, save $o->del_other_obj_on_save; # Set on save ok($o->other_obj_on_save(k1 => 1, k2 => 2, k3 => 3), "delete 4 foreign key object on save 1 - $db_type"); # Delete on save $o->del_other_obj_on_save; # Set-on-save to previous value $o->other_obj_on_save(k1 => 1, k2 => 2, k3 => 3); # Save $o->save; $other_obj = $o->other_obj_on_save; # Confirm that fk attrs are set... ok($other_obj && $other_obj->k1 == 1 && $other_obj->k2 == 2 && $other_obj->k3 == 3, "delete 4 foreign key object on save 2 - $db_type"); # Confirm that the new foreign object is there and the old one is not $co = MySQLiteOtherObject->new(k1 => 1, k2 => 2, k3 => 3); ok($co->load(speculative => 1), "delete 4 foreign key object on save 3 - $db_type"); $co = MySQLiteOtherObject->new(k1 => 12, k2 => 34, k3 => 56); ok(!$co->load(speculative => 1), "delete 4 foreign key object on save 4 - $db_type"); # End foreign key method tests # Start "one to many" method tests # # "one to many" get_set_now # #local $Rose::DB::Object::Debug = 1; #local $Rose::DB::Object::Manager::Debug = 1; # SETUP $o = MySQLiteObject->new(id => 111, name => 'Boo', flag => 1); @o2s = ( 1, MySQLiteOtherObject2->new(id => 2, name => 'two'), { id => 3, name => 'three' }, ); # Set before save, save, set eval { $o->other2_objs_now(@o2s) }; ok($@, "set one to many now 1 - $db_type"); $o->save; ok($o->other2_objs_now(@o2s), "set one to many now 2 - $db_type"); @o2s = $o->other2_objs_now; ok(@o2s == 3, "set one to many now 3 - $db_type"); ok($o2s[0]->id == 2 && $o2s[0]->pid == 111, "set one to many now 4 - $db_type"); ok($o2s[1]->id == 3 && $o2s[1]->pid == 111, "set one to many now 5 - $db_type"); ok($o2s[2]->id == 1 && $o2s[2]->pid == 111, "set one to many now 6 - $db_type"); my @fos = $o->find_other2_objs(query => [ id => { gt => 1 } ], sort_by => 'id desc', share_db => 0); ok($fos[0]->id == 3 && $fos[0]->pid == 111, "find one to many 1 - $db_type"); ok($fos[1]->id == 2 && $fos[1]->pid == 111, "find one to many 2 - $db_type"); ok(!defined $fos[0]->{'db'}, "find one to many 3 - $db_type"); ok(!defined $fos[1]->{'db'}, "find one to many 4 - $db_type"); @fos = $o->find_other2_objs([ id => { gt => 1 } ], sort_by => 'id desc', share_db => 0); ok($fos[0]->id == 3 && $fos[0]->pid == 111, "find one to many array query 1 - $db_type"); ok($fos[1]->id == 2 && $fos[1]->pid == 111, "find one to many array query 2 - $db_type"); ok(!defined $fos[0]->{'db'}, "find one to many array query 3 - $db_type"); ok(!defined $fos[1]->{'db'}, "find one to many array query 4 - $db_type"); @fos = $o->find_other2_objs([ id => 2 ]); ok($fos[0]->id == 2 && $fos[0]->pid == 111, "find one to many array query 5 - $db_type"); @fos = $o->find_other2_objs({ id => { gt => 1 } }, sort_by => 'id desc', share_db => 0); ok($fos[0]->id == 3 && $fos[0]->pid == 111, "find one to many hash query 1 - $db_type"); ok($fos[1]->id == 2 && $fos[1]->pid == 111, "find one to many hash query 2 - $db_type"); ok(!defined $fos[0]->{'db'}, "find one to many hash query 3 - $db_type"); ok(!defined $fos[1]->{'db'}, "find one to many hash query 4 - $db_type"); @fos = $o->find_other2_objs({ id => 2 }); ok($fos[0]->id == 2 && $fos[0]->pid == 111, "find one to many hash query 5 - $db_type"); @fos = $o->find_other2_objs(query => [ id => { le => 2 } ], sort_by => 'id desc', cache => 1); ok($fos[0]->id == 2 && $fos[0]->pid == 111, "find one to many cache 1 - $db_type"); ok($fos[1]->id == 1 && $fos[1]->pid == 111, "find one to many cache 2 - $db_type"); my @fos2 = $o->find_other2_objs(from_cache => 1); ok($fos2[0] eq $fos[0], "find one to many from_cache 1 - $db_type"); ok($fos2[1] eq $fos[1], "find one to many from_cache 2 - $db_type"); ok(my $o2objects_iterator = $o->other2_objs_iterator, "other2_objs_iterator - $db_type"); ok($o2objects_iterator->isa('Rose::DB::Object::Iterator'), "isa Iterator - $db_type"); while(my $o2i = $o2objects_iterator->next) { ok($o2i->isa('MySQLiteOtherObject2'), "isa MySQLiteOtherObject2 - $db_type"); } is($o2objects_iterator->total, 3, "MySQLiteOtherObject2 iterator total - $db_type"); $o2 = MySQLiteOtherObject2->new(id => 1)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 7 - $db_type"); $o2 = MySQLiteOtherObject2->new(id => 2)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 8 - $db_type"); $o2 = MySQLiteOtherObject2->new(id => 3)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 9 - $db_type"); my $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_other2 WHERE pid = 111'); $sth->execute; $count = $sth->fetchrow_array; $sth->finish; is($count, 3, "set one to many now 10 - $db_type"); # Set to undef $o->other2_objs_now(undef); @o2s = $o->other2_objs_now; ok(@o2s == 3, "set one to many now 11 - $db_type"); ok($o2s[0]->id == 2 && $o2s[0]->pid == 111, "set one to many now 12 - $db_type"); ok($o2s[1]->id == 3 && $o2s[1]->pid == 111, "set one to many now 13 - $db_type"); ok($o2s[2]->id == 1 && $o2s[2]->pid == 111, "set one to many now 14 - $db_type"); $o2 = MySQLiteOtherObject2->new(id => 1)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 15 - $db_type"); $o2 = MySQLiteOtherObject2->new(id => 2)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 16 - $db_type"); $o2 = MySQLiteOtherObject2->new(id => 3)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many now 17 - $db_type"); # RESET $o = MySQLiteObject->new(id => 111)->load; # Set (one existing, one new) @o2s = ( MySQLiteOtherObject2->new(id => 1, name => 'one'), MySQLiteOtherObject2->new(id => 7, name => 'seven'), ); ok($o->other2_objs_now(\@o2s), "set 2 one to many now 1 - $db_type"); $o2 = MySQLiteOtherObject2->new(id => 1)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many now 2 - $db_type"); $o2 = MySQLiteOtherObject2->new(id => 7)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many now 3 - $db_type"); @o2s = $o->other2_objs_now; ok(@o2s == 2, "set 2 one to many now 4 - $db_type"); ok($o2s[0]->id == 7 && $o2s[0]->pid == 111, "set 2 one to many now 5 - $db_type"); ok($o2s[1]->id == 1 && $o2s[1]->pid == 111, "set 2 one to many now 6 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_other2 WHERE pid = 111'); $sth->execute; $count = $sth->fetchrow_array; $sth->finish; is($count, 2, "set 2 one to many now 7 - $db_type"); # # "one to many" get_set_on_save # # SETUP $o2->db->dbh->do('DELETE FROM rose_db_object_other2'); $o = MySQLiteObject->new(id => 222, name => 'Hap', flag => 1); @o2s = ( MySQLiteOtherObject2->new(id => 5, name => 'five'), MySQLiteOtherObject2->new(id => 6, name => 'six'), MySQLiteOtherObject2->new(id => 7, name => 'seven'), ); $o->other2_objs_on_save(@o2s); @o2s = $o->other2_objs_on_save; ok(@o2s == 3, "set one to many on save 1 - $db_type"); ok($o2s[0]->id == 5 && $o2s[0]->pid == 222, "set one to many on save 2 - $db_type"); ok($o2s[1]->id == 6 && $o2s[1]->pid == 222, "set one to many on save 3 - $db_type"); ok($o2s[2]->id == 7 && $o2s[2]->pid == 222, "set one to many on save 4 - $db_type"); ok(!MySQLiteOtherObject2->new(id => 5)->load(speculative => 1), "set one to many on save 5 - $db_type"); ok(!MySQLiteOtherObject2->new(id => 6)->load(speculative => 1), "set one to many on save 6 - $db_type"); ok(!MySQLiteOtherObject2->new(id => 7)->load(speculative => 1), "set one to many on save 7 - $db_type"); $o->save; @o2s = $o->other2_objs_on_save; ok(@o2s == 3, "set one to many on save 8 - $db_type"); ok($o2s[0]->id == 6 && $o2s[0]->pid == 222, "set one to many on save 9 - $db_type"); ok($o2s[1]->id == 7 && $o2s[1]->pid == 222, "set one to many on save 10 - $db_type"); ok($o2s[2]->id == 5 && $o2s[2]->pid == 222, "set one to many on save 11 - $db_type"); $o2 = MySQLiteOtherObject2->new(id => 5)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many on save 12 - $db_type"); $o2 = MySQLiteOtherObject2->new(id => 6)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many on save 13 - $db_type"); $o2 = MySQLiteOtherObject2->new(id => 7)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set one to many on save 14 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_other2 WHERE pid = 222'); $sth->execute; $count = $sth->fetchrow_array; $sth->finish; is($count, 3, "set one to many on save 15 - $db_type"); # RESET $o = MySQLiteObject->new(id => 222)->load; # Set (one existing, one new) @o2s = ( MySQLiteOtherObject2->new(id => 7, name => 'seven'), MySQLiteOtherObject2->new(id => 12, name => 'one'), ); ok($o->other2_objs_on_save(\@o2s), "set 2 one to many on save 1 - $db_type"); $o2 = MySQLiteOtherObject2->new(id => 7)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many on save 2 - $db_type"); ok(!MySQLiteOtherObject2->new(id => 12)->load(speculative => 1), "set 2 one to many on save 3 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_other2 WHERE pid = 222'); $sth->execute; $count = $sth->fetchrow_array; $sth->finish; is($count, 3, "set 2 one to many on save 4 - $db_type"); @o2s = $o->other2_objs_on_save; ok(@o2s == 2, "set 2 one to many on save 5 - $db_type"); ok($o2s[0]->id == 7 && $o2s[0]->pid == 222, "set 2 one to many on save 6 - $db_type"); ok($o2s[1]->id == 12 && $o2s[1]->pid == 222, "set 2 one to many on save 7 - $db_type"); $o->save; @o2s = $o->other2_objs_on_save; ok(@o2s == 2, "set one to many on save 8 - $db_type"); ok($o2s[0]->id == 7 && $o2s[0]->pid == 222, "set 2 one to many on save 9 - $db_type"); ok($o2s[1]->id == 12 && $o2s[1]->pid == 222, "set 2 one to many on save 10 - $db_type"); $o2 = MySQLiteOtherObject2->new(id => 7)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many on save 11 - $db_type"); $o2 = MySQLiteOtherObject2->new(id => 12)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many on save 12 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_other2 WHERE pid = 222'); $sth->execute; $count = $sth->fetchrow_array; $sth->finish; is($count, 2, "set one to many on save 15 - $db_type"); # Set to undef $o->other2_objs_on_save(undef); @o2s = $o->other2_objs_on_save; ok(@o2s == 2, "set one to many on save 16 - $db_type"); ok($o2s[0]->id == 7 && $o2s[0]->pid == 222, "set 2 one to many on save 17 - $db_type"); ok($o2s[1]->id == 12 && $o2s[1]->pid == 222, "set 2 one to many on save 18 - $db_type"); $o2 = MySQLiteOtherObject2->new(id => 7)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many on save 19 - $db_type"); $o2 = MySQLiteOtherObject2->new(id => 12)->load(speculative => 1); ok($o2 && $o2->pid == $o->id, "set 2 one to many on save 20 - $db_type"); $o->save; @o2s = $o->other2_objs_on_save; push(@o2s, MySQLiteOtherObject2->new(name => 'added')); $o->other2_objs_on_save(\@o2s); $o->save; my $to = MySQLiteObject->new(id => $o->id)->load; @o2s = $o->other2_objs_on_save; is_deeply([ 'seven', 'one', 'added' ], [ map { $_->name } @o2s ], "add one to many on save 1 - $db_type"); # # "one to many" add_now # # SETUP $o2->db->dbh->do('DELETE FROM rose_db_object_other2'); $o = MySQLiteObject->new(id => 333, name => 'Zoom', flag => 1); $o->save; @o2s = ( MySQLiteOtherObject2->new(id => 5, name => 'five'), MySQLiteOtherObject2->new(id => 6, name => 'six'), MySQLiteOtherObject2->new(id => 7, name => 'seven'), ); $o->other2_objs_now(@o2s); # RESET $o = MySQLiteObject->new(id => 333, name => 'Zoom', flag => 1); # Add, no args @o2s = (); ok($o->add_other2_objs_now(@o2s) == 0, "add one to many now 1 - $db_type"); # Add before load/save @o2s = ( MySQLiteOtherObject2->new(id => 8, name => 'eight'), ); eval { $o->add_other2_objs_now(@o2s) }; ok($@, "add one to many now 2 - $db_type"); # Add $o->load; my $num = $o->add_other2_objs_now(@o2s); is($num, scalar @o2s, "add one to many now count - $db_type"); @o2s = $o->other2_objs; ok(@o2s == 4, "add one to many now 3 - $db_type"); ok($o2s[0]->id == 6 && $o2s[0]->pid == 333, "add one to many now 4 - $db_type"); ok($o2s[1]->id == 7 && $o2s[1]->pid == 333, "add one to many now 5 - $db_type"); ok($o2s[2]->id == 5 && $o2s[2]->pid == 333, "add one to many now 6 - $db_type"); ok($o2s[3]->id == 8 && $o2s[3]->pid == 333, "add one to many now 7 - $db_type"); ok(MySQLiteOtherObject2->new(id => 6)->load(speculative => 1), "add one to many now 8 - $db_type"); ok(MySQLiteOtherObject2->new(id => 7)->load(speculative => 1), "add one to many now 9 - $db_type"); ok(MySQLiteOtherObject2->new(id => 5)->load(speculative => 1), "add one to many now 10 - $db_type"); ok(MySQLiteOtherObject2->new(id => 8)->load(speculative => 1), "add one to many now 11 - $db_type"); # # "one to many" add_on_save # # SETUP $o2->db->dbh->do('DELETE FROM rose_db_object_other2'); $o = MySQLiteObject->new(id => 444, name => 'Blargh', flag => 1); # Set on save, add on save, save @o2s = ( MySQLiteOtherObject2->new(id => 10, name => 'ten'), ); # Set on save $o->other2_objs_on_save(@o2s); @o2s = $o->other2_objs; ok(@o2s == 1, "add one to many on save 1 - $db_type"); ok($o2s[0]->id == 10 && $o2s[0]->pid == 444, "add one to many on save 2 - $db_type"); ok(!MySQLiteOtherObject2->new(id => 10)->load(speculative => 1), "add one to many on save 3 - $db_type"); @o2s = ( MySQLiteOtherObject2->new(id => 9, name => 'nine'), ); # Add on save $num = $o->add_other2_objs(@o2s); is($num, scalar @o2s, "add one to many on save 4 - $db_type"); @o2s = $o->other2_objs; ok(@o2s == 2, "add one to many on save 5 - $db_type"); ok($o2s[0]->id == 10 && $o2s[0]->pid == 444, "add one to many on save 6 - $db_type"); ok($o2s[1]->id == 9 && $o2s[0]->pid == 444, "add one to many on save 7 - $db_type"); ok(!MySQLiteOtherObject2->new(id => 10)->load(speculative => 1), "add one to many on save 8 - $db_type"); ok(!MySQLiteOtherObject2->new(id => 9)->load(speculative => 1), "add one to many on save 9 - $db_type"); $o->save; @o2s = $o->other2_objs; ok(@o2s == 2, "add one to many on save 10 - $db_type"); ok($o2s[0]->id == 10 && $o2s[0]->pid == 444, "add one to many on save 11 - $db_type"); ok($o2s[1]->id == 9 && $o2s[1]->pid == 444, "add one to many on save 12 - $db_type"); ok(MySQLiteOtherObject2->new(id => 10)->load(speculative => 1), "add one to many on save 13 - $db_type"); ok(MySQLiteOtherObject2->new(id => 9)->load(speculative => 1), "add one to many on save 14 - $db_type"); # RESET $o = MySQLiteObject->new(id => 444, name => 'Blargh', flag => 1); $o->load; # Add on save, save @o2s = ( MySQLiteOtherObject2->new(id => 11, name => 'eleven'), ); # Add on save ok($o->add_other2_objs(\@o2s), "add one to many on save 15 - $db_type"); @o2s = $o->other2_objs; ok(@o2s == 2, "add one to many on save 16 - $db_type"); ok($o2s[0]->id == 10 && $o2s[0]->pid == 444, "add one to many on save 17 - $db_type"); ok($o2s[1]->id == 9 && $o2s[1]->pid == 444, "add one to many on save 18 - $db_type"); ok(MySQLiteOtherObject2->new(id => 10)->load(speculative => 1), "add one to many on save 19 - $db_type"); ok(MySQLiteOtherObject2->new(id => 9)->load(speculative => 1), "add one to many on save 20 - $db_type"); ok(!MySQLiteOtherObject2->new(id => 11)->load(speculative => 1), "add one to many on save 21 - $db_type"); # Save $o->save; @o2s = $o->other2_objs; ok(@o2s == 3, "add one to many on save 22 - $db_type"); ok($o2s[0]->id == 10 && $o2s[0]->pid == 444, "add one to many on save 23 - $db_type"); ok($o2s[1]->id == 9 && $o2s[1]->pid == 444, "add one to many on save 24 - $db_type"); ok($o2s[2]->id == 11 && $o2s[2]->pid == 444, "add one to many on save 25 - $db_type"); ok(MySQLiteOtherObject2->new(id => 10)->load(speculative => 1), "add one to many on save 26 - $db_type"); ok(MySQLiteOtherObject2->new(id => 9)->load(speculative => 1), "add one to many on save 27 - $db_type"); ok(MySQLiteOtherObject2->new(id => 11)->load(speculative => 1), "add one to many on save 28 - $db_type"); # End "one to many" method tests # Start "load with ..." tests ok($o = MySQLiteObject->new(id => 444)->load(with => [ qw(other_obj other2_objs colors) ]), "load with 1 - $db_type"); $o->{'other2_objs'} = [ sort { $a->{'name'} cmp $b->{'name'} } @{$o->{'other2_objs'}} ]; ok($o->{'other2_objs'} && $o->{'other2_objs'}[1]->name eq 'nine', "load with 2 - $db_type"); $o = MySQLiteObject->new(id => 999); ok(!$o->load(with => [ qw(other_obj other2_objs colors) ], speculative => 1), "load with 3 - $db_type"); $o = MySQLiteObject->new(id => 222); ok($o->load(with => 'colors'), "load with 4 - $db_type"); # End "load with ..." tests # Start "many to many" tests # # "many to many" get_set_now # # SETUP $o = MySQLiteObject->new(id => 30, name => 'Color', flag => 1); # Set @colors = ( 1, # red MySQLiteColor->new(id => 3), # blue { id => 5, name => 'orange' }, ); #MySQLiteColor->new(id => 2), # green #MySQLiteColor->new(id => 4), # pink # Set before save, save, set eval { $o->colors_now(@colors) }; ok($@, "set many to many now 1 - $db_type"); $o->save; ok($o->colors_now(@colors), "set many to many now 2 - $db_type"); @colors = $o->colors_now; ok(@colors == 3, "set many to many now 3 - $db_type"); ok($colors[0]->id == 3, "set many to many now 4 - $db_type"); ok($colors[1]->id == 5, "set many to many now 5 - $db_type"); ok($colors[2]->id == 1, "set many to many now 6 - $db_type"); $color = MySQLiteColor->new(id => 5); ok($color->load(speculative => 1), "set many to many now 7 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 30, color_id => 3)->load(speculative => 1), "set many to many now 8 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 30, color_id => 5)->load(speculative => 1), "set many to many now 9 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 30, color_id => 1)->load(speculative => 1), "set many to many now 10 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 30'); $sth->execute; $count = $sth->fetchrow_array; $sth->finish; is($count, 3, "set many to many now 11 - $db_type"); # Set to undef $o->colors_now(undef); @colors = $o->colors_now; ok(@colors == 3, "set 2 many to many now 1 - $db_type"); ok($colors[0]->id == 3, "set 2 many to many now 2 - $db_type"); ok($colors[1]->id == 5, "set 2 many to many now 3 - $db_type"); ok($colors[2]->id == 1, "set 2 many to many now 4 - $db_type"); $color = MySQLiteColor->new(id => 5); ok($color->load(speculative => 1), "set 2 many to many now 5 - $db_type"); $color = MySQLiteColor->new(id => 3); ok($color->load(speculative => 1), "set 2 many to many now 6 - $db_type"); $color = MySQLiteColor->new(id => 1); ok($color->load(speculative => 1), "set 2 many to many now 7 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 30, color_id => 3)->load(speculative => 1), "set 2 many to many now 8 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 30, color_id => 5)->load(speculative => 1), "set 2 many to many now 9 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 30, color_id => 1)->load(speculative => 1), "set 2 many to many now 10 - $db_type"); $sth = $o2->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 30'); $sth->execute; $count = $sth->fetchrow_array; $sth->finish; is($count, 3, "set 2 many to many now 11 - $db_type"); # # "many to many" get_set_on_save # # SETUP $o = MySQLiteObject->new(id => 40, name => 'Cool', flag => 1); # Set @colors = ( MySQLiteColor->new(id => 1), # red 3, # blue { id => 6, name => 'ochre' }, ); #MySQLiteColor->new(id => 2), # green #MySQLiteColor->new(id => 4), # pink $o->colors_on_save(@colors); @colors = $o->colors_on_save; ok(@colors == 3, "set many to many on save 1 - $db_type"); ok($colors[0]->id == 1, "set many to many on save 2 - $db_type"); ok($colors[1]->id == 3, "set many to many on save 3 - $db_type"); ok($colors[2]->id == 6, "set many to many on save 4 - $db_type"); ok(MySQLiteColor->new(id => 1)->load(speculative => 1), "set many to many on save 5 - $db_type"); ok(MySQLiteColor->new(id => 3)->load(speculative => 1), "set many to many on save 6 - $db_type"); ok(!MySQLiteColor->new(id => 6)->load(speculative => 1), "set many to many on save 7 - $db_type"); ok(!MySQLiteColorMap->new(obj_id => 40, color_id => 1)->load(speculative => 1), "set many to many on save 8 - $db_type"); ok(!MySQLiteColorMap->new(obj_id => 40, color_id => 3)->load(speculative => 1), "set many to many on save 9 - $db_type"); ok(!MySQLiteColorMap->new(obj_id => 40, color_id => 6)->load(speculative => 1), "set many to many on save 10 - $db_type"); $o->save; @colors = $o->colors_on_save; ok(@colors == 3, "set many to many on save 11 - $db_type"); ok($colors[0]->id == 3, "set many to many on save 12 - $db_type"); ok($colors[1]->id == 6, "set many to many on save 13 - $db_type"); ok($colors[2]->id == 1, "set many to many on save 14 - $db_type"); ok(MySQLiteColor->new(id => 1)->load(speculative => 1), "set many to many on save 15 - $db_type"); ok(MySQLiteColor->new(id => 3)->load(speculative => 1), "set many to many on save 16 - $db_type"); ok(MySQLiteColor->new(id => 6)->load(speculative => 1), "set many to many on save 17 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 40, color_id => 1)->load(speculative => 1), "set 2 many to many on save 18 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 40, color_id => 3)->load(speculative => 1), "set 2 many to many on save 19 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 40, color_id => 6)->load(speculative => 1), "set 2 many to many on save 20 - $db_type"); $sth = $color->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 40'); $sth->execute; $count = $sth->fetchrow_array; $sth->finish; is($count, 3, "set many to many on save 21 - $db_type"); # RESET $o = MySQLiteObject->new(id => 40)->load; # Set to undef $o->colors_on_save(undef); @colors = $o->colors_on_save; ok(@colors == 3, "set 2 many to many on save 1 - $db_type"); ok($colors[0]->id == 3, "set 2 many to many on save 2 - $db_type"); ok($colors[1]->id == 6, "set 2 many to many on save 3 - $db_type"); ok($colors[2]->id == 1, "set 2 many to many on save 4 - $db_type"); ok(MySQLiteColor->new(id => 1)->load(speculative => 1), "set 2 many to many on save 5 - $db_type"); ok(MySQLiteColor->new(id => 3)->load(speculative => 1), "set 2 many to many on save 6 - $db_type"); ok(MySQLiteColor->new(id => 6)->load(speculative => 1), "set 2 many to many on save 7 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 40, color_id => 1)->load(speculative => 1), "set 2 many to many on save 8 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 40, color_id => 3)->load(speculative => 1), "set 2 many to many on save 9 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 40, color_id => 6)->load(speculative => 1), "set 2 many to many on save 10 - $db_type"); $sth = $color->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 40'); $sth->execute; $count = $sth->fetchrow_array; $sth->finish; is($count, 3, "set 2 many to many on save 11 - $db_type"); $o->colors([]); $o->save(changes_only => 1); $o->colors_on_save({ id => 1, name => 'redx' }, { id => 3 }); $o->save(changes_only => 1); $o->colors_on_save(undef); $colors = $o->colors_on_save; ok(ref $colors eq 'ARRAY' && @$colors == 2 && $colors->[0]->name eq 'blue' && $colors->[1]->name eq 'redx', "colors merge 1 - $db_type"); $o->colors_on_save({ id => 2 }, { id => 3, name => 'bluex' }); $o->save(changes_only => 1); $o->colors_on_save(undef); $colors = $o->colors_on_save; ok(ref $colors eq 'ARRAY' && @$colors == 2 && $colors->[0]->name eq 'bluex' && $colors->[1]->name eq 'green', "colors merge 2 - $db_type"); # # "many to many" add_now # # SETUP $o = MySQLiteObject->new(id => 50, name => 'Blat', flag => 1); $o->delete; @colors = ( MySQLiteColor->new(id => 1), # red MySQLiteColor->new(id => 3), # blue ); #MySQLiteColor->new(id => 4), # pink $o->colors_on_save(\@colors); $o->save; $o = MySQLiteObject->new(id => 50, name => 'Blat', flag => 1); # Add, no args @colors = (); ok($o->add_colors(@colors) == 0, "add many to many now 1 - $db_type"); # Add before load/save @colors = ( MySQLiteColor->new(id => 7, name => 'puce'), MySQLiteColor->new(id => 2), # green ); eval { $o->add_colors(@colors) }; ok($@, "add many to many now 2 - $db_type"); # Add $o->load; $o->add_colors(@colors); @colors = $o->colors; ok(@colors == 4, "add many to many now 3 - $db_type"); ok($colors[0]->id == 3, "add many to many now 4 - $db_type"); ok($colors[1]->id == 2, "add many to many now 5 - $db_type"); ok($colors[2]->id == 7, "add many to many now 6 - $db_type"); ok($colors[3]->id == 1, "add many to many now 7 - $db_type"); ok(MySQLiteColor->new(id => 3)->load(speculative => 1), "add many to many now 8 - $db_type"); ok(MySQLiteColor->new(id => 2)->load(speculative => 1), "add many to many now 9 - $db_type"); ok(MySQLiteColor->new(id => 7)->load(speculative => 1), "add many to many now 10 - $db_type"); ok(MySQLiteColor->new(id => 1)->load(speculative => 1), "add many to many now 11 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 50, color_id => 3)->load(speculative => 1), "set 2 many to many on save 12 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 50, color_id => 2)->load(speculative => 1), "set 2 many to many on save 13 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 50, color_id => 7)->load(speculative => 1), "set 2 many to many on save 14 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 50, color_id => 1)->load(speculative => 1), "set 2 many to many on save 15 - $db_type"); # # "many to many" add_on_save # # SETUP $o = MySQLiteObject->new(id => 60, name => 'Cretch', flag => 1); $o->delete; # Set on save, add on save, save @colors = ( MySQLiteColor->new(id => 1), # red MySQLiteColor->new(id => 2), # green ); # Set on save $o->colors_on_save(@colors); @colors = ( MySQLiteColor->new(id => 7), # puce MySQLiteColor->new(id => 8, name => 'tan'), ); # Add on save ok($o->add_colors_on_save(@colors), "add many to many on save 1 - $db_type"); @colors = $o->colors; ok(@colors == 4, "add many to many on save 2 - $db_type"); ok($colors[0]->id == 1, "add many to many on save 3 - $db_type"); ok($colors[1]->id == 2, "add many to many on save 4 - $db_type"); ok($colors[2]->id == 7, "add many to many on save 5 - $db_type"); ok($colors[3]->id == 8, "add many to many on save 6 - $db_type"); ok(MySQLiteColor->new(id => 1)->load(speculative => 1), "add many to many on save 7 - $db_type"); ok(MySQLiteColor->new(id => 2)->load(speculative => 1), "add many to many on save 8 - $db_type"); ok(MySQLiteColor->new(id => 7)->load(speculative => 1), "add many to many on save 9 - $db_type"); ok(!MySQLiteColor->new(id => 8)->load(speculative => 1), "add many to many on save 10 - $db_type"); ok(!MySQLiteColorMap->new(obj_id => 60, color_id => 1)->load(speculative => 1), "set many to many on save 11 - $db_type"); ok(!MySQLiteColorMap->new(obj_id => 60, color_id => 2)->load(speculative => 1), "set many to many on save 12 - $db_type"); ok(!MySQLiteColorMap->new(obj_id => 60, color_id => 7)->load(speculative => 1), "set many to many on save 13 - $db_type"); ok(!MySQLiteColorMap->new(obj_id => 60, color_id => 8)->load(speculative => 1), "set many to many on save 14 - $db_type"); $o->save; @colors = $o->colors; ok(@colors == 4, "add many to many on save 15 - $db_type"); ok($colors[0]->id == 2, "add many to many on save 16 - $db_type"); ok($colors[1]->id == 7, "add many to many on save 17 - $db_type"); ok($colors[2]->id == 1, "add many to many on save 18 - $db_type"); ok($colors[3]->id == 8, "add many to many on save 19 - $db_type"); ok(MySQLiteColor->new(id => 2)->load(speculative => 1), "add many to many on save 20 - $db_type"); ok(MySQLiteColor->new(id => 7)->load(speculative => 1), "add many to many on save 21 - $db_type"); ok(MySQLiteColor->new(id => 1)->load(speculative => 1), "add many to many on save 22 - $db_type"); ok(MySQLiteColor->new(id => 8)->load(speculative => 1), "add many to many on save 21 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 60, color_id => 2)->load(speculative => 1), "add many to many on save 22 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 60, color_id => 7)->load(speculative => 1), "add many to many on save 23 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 60, color_id => 1)->load(speculative => 1), "add many to many on save 24 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 60, color_id => 8)->load(speculative => 1), "add many to many on save 25 - $db_type"); $sth = $color->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 60'); $sth->execute; $count = $sth->fetchrow_array; $sth->finish; is($count, 4, "add many to many on save 26 - $db_type"); # RESET $o = MySQLiteObject->new(id => 60, name => 'Cretch', flag => 1); $o->load(with => 'colors'); # Add on save, save @colors = ( MySQLiteColor->new(id => 9, name => 'aqua'), ); # Add on save ok($o->add_colors_on_save(@colors), "add 2 many to many on save 1 - $db_type"); @colors = $o->colors; ok(@colors == 5, "add 2 many to many on save 16 - $db_type"); @colors = sort { $a->{'name'} cmp $b->{'name'} } @colors; ok($colors[0]->id == 9, "add 2 many to many on save 2 - $db_type"); ok($colors[1]->id == 2, "add 2 many to many on save 3 - $db_type"); ok($colors[2]->id == 7, "add 2 many to many on save 4 - $db_type"); ok($colors[3]->id == 1, "add 2 many to many on save 5 - $db_type"); ok($colors[4]->id == 8, "add 2 many to many on save 6 - $db_type"); ok(!MySQLiteColor->new(id => 9)->load(speculative => 1), "add many to many on save 7 - $db_type"); ok(MySQLiteColor->new(id => 2)->load(speculative => 1), "add many to many on save 8 - $db_type"); ok(MySQLiteColor->new(id => 7)->load(speculative => 1), "add many to many on save 9 - $db_type"); ok(MySQLiteColor->new(id => 1)->load(speculative => 1), "add many to many on save 10 - $db_type"); ok(MySQLiteColor->new(id => 8)->load(speculative => 1), "add many to many on save 11 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 60, color_id => 2)->load(speculative => 1), "add 2 many to many on save 12 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 60, color_id => 7)->load(speculative => 1), "add 2 many to many on save 13 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 60, color_id => 1)->load(speculative => 1), "add 2 many to many on save 14 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 60, color_id => 8)->load(speculative => 1), "add 2 many to many on save 15 - $db_type"); ok(!MySQLiteColorMap->new(obj_id => 60, color_id => 9)->load(speculative => 1), "add 2 many to many on save 16 - $db_type"); $sth = $color->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 60'); $sth->execute; $count = $sth->fetchrow_array; $sth->finish; is($count, 4, "add 2 many to many on save 17 - $db_type"); # Save $o->save; @colors = $o->colors; ok(@colors == 5, "add 2 many to many on save 18 - $db_type"); ok($colors[0]->id == 9, "add 2 many to many on save 19 - $db_type"); ok($colors[1]->id == 2, "add 2 many to many on save 20 - $db_type"); ok($colors[2]->id == 7, "add 2 many to many on save 21 - $db_type"); ok($colors[3]->id == 1, "add 2 many to many on save 22 - $db_type"); ok($colors[4]->id == 8, "add 2 many to many on save 23 - $db_type"); ok(MySQLiteColor->new(id => 9)->load(speculative => 1), "add many to many on save 24 - $db_type"); ok(MySQLiteColor->new(id => 2)->load(speculative => 1), "add many to many on save 25 - $db_type"); ok(MySQLiteColor->new(id => 7)->load(speculative => 1), "add many to many on save 26 - $db_type"); ok(MySQLiteColor->new(id => 1)->load(speculative => 1), "add many to many on save 27 - $db_type"); ok(MySQLiteColor->new(id => 8)->load(speculative => 1), "add many to many on save 28 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 60, color_id => 9)->load(speculative => 1), "add 2 many to many on save 29 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 60, color_id => 2)->load(speculative => 1), "add 2 many to many on save 20 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 60, color_id => 7)->load(speculative => 1), "add 2 many to many on save 31 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 60, color_id => 1)->load(speculative => 1), "add 2 many to many on save 32 - $db_type"); ok(MySQLiteColorMap->new(obj_id => 60, color_id => 8)->load(speculative => 1), "add 2 many to many on save 33 - $db_type"); $sth = $color->db->dbh->prepare('SELECT COUNT(*) FROM rose_db_object_colors_map WHERE obj_id = 60'); $sth->execute; $count = $sth->fetchrow_array; $sth->finish; is($count, 5, "add 2 many to many on save 34 - $db_type"); # End "many to many" tests # Begin with_map_records tests test_memory_cycle_ok($o, "with_map_records memory cycle 1 - $db_type"); # print find_cycle($o); # print "######################\n"; #$DB::single = 1; @colors = $o->colors2; # use Devel::Cycle; # print find_cycle($o); # exit; is($colors[0]->map_record->color_id, $colors[0]->id, "with_map_records rel 1 - $db_type"); is($colors[0]->map_record->obj_id, $o->id, "with_map_records rel 2 - $db_type"); #exit; @colors = $o->colors3; is($colors[-1]->map_rec->color_id, $colors[-1]->id, "with_map_records rel 3 - $db_type"); is($colors[-1]->map_rec->obj_id, $o->id, "with_map_records rel 4 - $db_type"); is($colors[-1]->map_rec->color_id, 1, "with_map_records rel 5 - $db_type"); my $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', query => [ id => $o->id ], require_objects => [ 'colors3' ], with_map_records => { colors3 => 'mrec' }); $objs->[0]->{'colors3'} = [ sort { $b->mrec->color_id <=> $a->mrec->color_id } @{$objs->[0]->{'colors3'}} ]; is($objs->[0]->colors3->[0]->mrec->color_id, $objs->[0]->colors3->[0]->id, "with_map_records mrec 1 - $db_type"); is($objs->[0]->colors3->[0]->mrec->obj_id, $o->id, "with_map_records mrec 2 - $db_type"); is($objs->[0]->colors3->[0]->mrec->color_id, 9, "with_map_records mrec 3 - $db_type"); is($objs->[0]->colors3->[-1]->mrec->color_id, 1, "with_map_records mrec 4 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', query => [ id => [ $o->id, 333 ] ], with_objects => [ 'colors3' ], with_map_records => 1, sort_by => 'name DESC'); is($objs->[1]->colors3->[0]->map_rec->color_id, $objs->[1]->colors3->[0]->id, "with_map_records map_rec 1 - $db_type"); is($objs->[1]->colors3->[0]->map_rec->obj_id, $o->id, "with_map_records map_rec 2 - $db_type"); is($objs->[1]->colors3->[0]->map_rec->color_id, 9, "with_map_records map_rec 3 - $db_type"); is($objs->[1]->colors3->[-1]->map_rec->color_id, 1, "with_map_records map_rec 4 - $db_type"); is($objs->[0]->name, 'Zoom', "with_map_records map_rec 5 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', query => [ id => $o->id ], require_objects => [ 'colors2' ], with_map_records => 1); is($objs->[0]->colors2->[0]->map_record->color_id, $objs->[0]->colors2->[0]->id, "with_map_records map_record 1 - $db_type"); is($objs->[0]->colors2->[0]->map_record->obj_id, $o->id, "with_map_records map_record 2 - $db_type"); $objs = Rose::DB::Object::Manager->get_objects( object_class => 'MySQLiteObject', query => [ id => $o->id ], require_objects => [ 'colors2' ], with_map_records => 1); is($objs->[0]->colors2->[0]->map_record->color_id, $objs->[0]->colors2->[0]->id, "with_map_records map_record 1 - $db_type"); is($objs->[0]->colors2->[0]->map_record->obj_id, $o->id, "with_map_records map_record 2 - $db_type"); my $iter = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MySQLiteObject', query => [ id => $o->id ], require_objects => [ 'colors3' ], with_map_records => { colors3 => 'mrec' }); $obj = $iter->next; $obj->{'colors3'} = [ sort { $b->mrec->color_id <=> $a->mrec->color_id } @{$obj->{'colors3'}} ]; is($obj->colors3->[0]->mrec->color_id, $obj->colors3->[0]->id, "with_map_records mrec 1 - $db_type"); is($obj->colors3->[0]->mrec->obj_id, $o->id, "with_map_records mrec 2 - $db_type"); is($obj->colors3->[0]->mrec->color_id, 9, "with_map_records mrec 3 - $db_type"); is($obj->colors3->[-1]->mrec->color_id, 1, "with_map_records mrec 4 - $db_type"); $iter = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MySQLiteObject', query => [ id => [ $o->id, 333 ] ], with_objects => [ 'colors3' ], with_map_records => 1, sort_by => 'name DESC'); $obj = $iter->next; is($obj->name, 'Zoom', "with_map_records map_rec 5 - $db_type"); $obj = $iter->next; is($obj->colors3->[0]->map_rec->color_id, $obj->colors3->[0]->id, "with_map_records map_rec 1 - $db_type"); is($obj->colors3->[0]->map_rec->obj_id, $o->id, "with_map_records map_rec 2 - $db_type"); is($obj->colors3->[0]->map_rec->color_id, 9, "with_map_records map_rec 3 - $db_type"); is($obj->colors3->[-1]->map_rec->color_id, 1, "with_map_records map_rec 4 - $db_type"); $iter = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MySQLiteObject', query => [ id => $o->id ], require_objects => [ 'colors2' ], with_map_records => 1); $obj = $iter->next; is($obj->colors2->[0]->map_record->color_id, $obj->colors2->[0]->id, "with_map_records map_record 1 - $db_type"); is($obj->colors2->[0]->map_record->obj_id, $o->id, "with_map_records map_record 2 - $db_type"); $iter = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'MySQLiteObject', query => [ id => $o->id ], require_objects => [ 'colors2' ], with_map_records => 1); $obj = $iter->next; is($obj->colors2->[0]->map_record->color_id, $obj->colors2->[0]->id, "with_map_records map_record 1 - $db_type"); is($obj->colors2->[0]->map_record->obj_id, $o->id, "with_map_records map_record 2 - $db_type"); # End with_map_records tests # Start create with map records tests $o = MySQLiteObject->new(name => 'WMR'); $o->colors3({ name => 'Gray', map_rec => { id => 999, arb_attr => 'Whee' } }); $o->save; is($o->colors3->[0]->map_rec->arb_attr, 'Whee', "save with map_rec 1 - $db_type"); $o = MySQLiteColorMap->new(id => 999)->load; is($o->arb_attr, 'Whee', "save with map_rec 2 - $db_type"); # End create with map records tests # Start multiple add_on_save tests $o = MySQLiteObject->new(name => 'John', id => 10); $o->add_other2_objs2({ name => 'xa' }, { name => 'xb' }); $o->add_other2_objs2({ name => 'xc' }); $o->save; is(join(',', sort map { $_->name } $o->other2_objs2), 'xa,xb,xc', "Multiple add_on_save one-to-many 1 - $db_type"); $o = MySQLiteObject->new(id => 10)->load; $o->add_colors({ name => 'za' }, { name => 'zb' }); $o->add_colors({ name => 'zc' }); $o->save; is(join(',', sort map { $_->name } $o->colors), 'za,zb,zc', "Multiple add_on_save many-to-many 1 - $db_type"); $o = MySQLiteObject->new(name => 'John', id => 11); $o->other2_objs2; $o->add_other2_objs2({ name => 'xa2' }, { name => 'xb2' }); $o->add_other2_objs2({ name => 'xc2' }); is(join(',', sort map { $_->name } $o->other2_objs2), 'xa2,xb2,xc2', "Multiple add_on_save one-to-many 2 - $db_type"); $o->save; is(join(',', sort map { $_->name } $o->other2_objs2), 'xa2,xb2,xc2', "Multiple add_on_save one-to-many 3 - $db_type"); $o = MySQLiteObject->new(id => 11)->load; $o->colors; $o->add_colors({ name => 'za2' }, { name => 'zb2' }); $o->add_colors({ name => 'zc2' }); is(join(',', sort map { $_->name } $o->colors), 'za2,zb2,zc2', "Multiple add_on_save many-to-many 2 - $db_type"); $o->save; is(join(',', sort map { $_->name } $o->colors), 'za2,zb2,zc2', "Multiple add_on_save many-to-many 3 - $db_type"); # End multiple add_on_save tests # Start fk hook-up tests $o2 = MySQLiteOtherObject2->new(name => 'B', pid => 11); $o2->save; $o = MySQLiteObject->new(name => 'John', id => 12); $o->add_other2_objs2($o2); $o2->name('John2'); $o->save; $o2 = MySQLiteOtherObject2->new(id => $o2->id)->load; is($o2->pid, $o->id, "fk hook-up 1 - $db_type"); is($o2->name, 'John2', "fk hook-up 2 - $db_type"); # End fk hook-up tests test_meta(MySQLiteOtherObject2->meta, 'MySQLite', $db_type); } BEGIN { # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_PG = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->do('DROP TABLE rose_db_object_colors_map CASCADE'); $dbh->do('DROP TABLE rose_db_object_colors'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->do('DROP TABLE rose_db_object_other2'); $dbh->do('DROP TABLE rose_db_object_chkpass_test'); } our $PG_HAS_CHKPASS = pg_has_chkpass(); $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32), UNIQUE(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id SERIAL PRIMARY KEY, @{[ $PG_HAS_CHKPASS ? 'password CHKPASS,' : '' ]} name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits BIT(5) NOT NULL DEFAULT B'00101', start DATE, save INT, nums INT[], fk1 INT, fk2 INT, fk3 INT, last_modified TIMESTAMP, date_created TIMESTAMP, FOREIGN KEY (fk1, fk2, fk3) REFERENCES rose_db_object_other (k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other2 ( id SERIAL PRIMARY KEY, name VARCHAR(255), pid INT NOT NULL REFERENCES rose_db_object_test (id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_colors ( id SERIAL PRIMARY KEY, name VARCHAR(255) NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_colors_map ( id SERIAL PRIMARY KEY, obj_id INT NOT NULL REFERENCES rose_db_object_test (id), color_id INT NOT NULL REFERENCES rose_db_object_colors (id), arb_attr VARCHAR(64), UNIQUE(obj_id, color_id) ) EOF $dbh->disconnect; # Create test subclasses package MyPgOtherObject; our @ISA = qw(Rose::DB::Object); our $DB; sub init_db { $DB ||= Rose::DB->new('pg') } MyPgOtherObject->meta->table('rose_db_object_other'); MyPgOtherObject->meta->columns ( name => { type => 'varchar'}, k1 => { type => 'int' }, k2 => { type => 'int' }, k3 => { type => 'int' }, ); MyPgOtherObject->meta->primary_key_columns([ qw(k1 k2 k3) ]); MyPgOtherObject->meta->initialize; package MyPgObject; use Rose::DB::Object::Helpers qw(has_loaded_related forget_related); our @ISA = qw(Rose::DB::Object); our $DB; sub init_db { $DB ||= Rose::DB->new('pg') } MyPgObject->meta->table('rose_db_object_test'); MyPgObject->meta->columns ( 'name', id => { primary_key => 1 }, ($PG_HAS_CHKPASS ? (password => { type => 'chkpass' }) : ()), flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, nums => { type => 'array' }, bits => { type => 'bitfield', bits => 5, default => 101 }, fk1 => { type => 'int' }, fk2 => { type => 'int' }, fk3 => { type => 'int' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); MyPgObject->meta->foreign_keys ( other_obj => { class => 'MyPgOtherObject', rel_type => 'one to one', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, methods => { get_set_now => undef, get_set_on_save => 'other_obj_on_save', delete_now => undef, delete_on_save => 'del_other_obj_on_save', }, }, ); MyPgObject->meta->relationships ( other_objx => { type => 'one to one', class => 'MyPgOtherObject', column_map => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, required => 1, }, other2_objs => { type => 'one to many', class => 'MyPgOtherObject2', column_map => { id => 'pid' }, manager_args => { sort_by => 'name DESC' }, methods => { get_set => undef, get_set_now => 'other2_objs_now', get_set_on_save => 'other2_objs_on_save', add_now => 'add_other2_objs_now', add_on_save => undef, }, }, other2_a_objs => { type => 'one to many', class => 'MyPgOtherObject2', column_map => { id => 'pid' }, query_args => [ name => { like => 'a%' } ], manager_args => { sort_by => 'name' }, }, other_obj_osoft => { type => 'one to one', class => 'MyPgOtherObject', column_map => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, referential_integrity => 0, }, other_obj_msoft => { type => 'many to one', class => 'MyPgOtherObject', column_map => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, soft => 1, }, ); MyPgObject->meta->alias_column(fk1 => 'fkone'); MyPgObject->meta->add_relationship ( colors => { type => 'many to many', map_class => 'MyPgColorMap', #map_from => 'object', #map_to => 'color', manager_args => { sort_by => 'rose_db_object_colors.name' }, methods => { get_set => undef, get_set_now => 'colors_now', get_set_on_save => 'colors_on_save', add_now => undef, add_on_save => 'add_colors_on_save', find => undef, count => undef, }, }, ); eval { MyPgObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method - pg'); MyPgObject->meta->alias_column(save => 'save_col'); MyPgObject->meta->initialize(preserve_existing => 1); my $meta = MyPgObject->meta; Test::More::is($meta->relationship('other_obj')->foreign_key, $meta->foreign_key('other_obj'), 'foreign key sync 1 - pg'); package MyPgOtherObject2; our @ISA = qw(Rose::DB::Object); our $DB; sub init_db { $DB ||= Rose::DB->new('pg') } MyPgOtherObject2->meta->table('rose_db_object_other2'); MyPgOtherObject2->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar'}, pid => { type => 'int' }, ); MyPgOtherObject2->meta->relationships ( other_obj => { type => 'one to one', class => 'MyPgObject', column_map => { pid => 'id' }, required => 1, }, ); MyPgOtherObject2->meta->foreign_keys ( other_obj => { class => 'MyPgObject', relationship_type => 'one to one', key_columns => { pid => 'id' }, }, ); MyPgOtherObject2->meta->initialize; package MyPgColor; our @ISA = qw(Rose::DB::Object); our $DB; sub init_db { $DB ||= Rose::DB->new('pg') } MyPgColor->meta->table('rose_db_object_colors'); MyPgColor->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', not_null => 1 }, ); MyPgColor->meta->unique_key('name'); MyPgColor->meta->initialize; package MyPgColorMap; our @ISA = qw(Rose::DB::Object); our $DB; sub init_db { $DB ||= Rose::DB->new('pg') } MyPgColorMap->meta->table('rose_db_object_colors_map'); MyPgColorMap->meta->columns ( id => { type => 'serial', primary_key => 1 }, obj_id => { type => 'int', not_null => 1 }, color_id => { type => 'int', not_null => 1 }, ); MyPgColorMap->meta->unique_keys([ 'obj_id', 'color_id' ]); MyPgColorMap->meta->foreign_keys ( object => { class => 'MyPgObject', key_columns => { obj_id => 'id' }, }, color => { class => 'MyPgColor', key_columns => { color_id => 'id' }, }, ); MyPgColorMap->meta->initialize; } # # MySQL # my $db_version; eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh() or die Rose::DB->error; $db_version = $db->database_version; }; if(!$@ && $dbh) { our $HAVE_MYSQL = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->do('DROP TABLE rose_db_object_colors_map CASCADE'); $dbh->do('DROP TABLE rose_db_object_colors'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->do('DROP TABLE rose_db_object_other2'); $dbh->do('DROP TABLE rose_db_object_chkpass_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32), KEY(k1, k2, k3) ) EOF # MySQL 5.0.3 or later has a completely stupid "native" BIT type my $bit_col = ($db_version >= 5_000_003) ? q(bits BIT(5) NOT NULL DEFAULT B'00101') : q(bits BIT(5) NOT NULL DEFAULT '00101'); $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, name VARCHAR(32) NOT NULL, flag TINYINT(1) NOT NULL, flag2 TINYINT(1), status VARCHAR(32) DEFAULT 'active', $bit_col, start DATE, save INT, fk1 INT, fk2 INT, fk3 INT, last_modified TIMESTAMP, date_created DATETIME ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other2 ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255), pid INT UNSIGNED NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_colors ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_colors_map ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, obj_id INT NOT NULL REFERENCES rose_db_object_test (id), color_id INT NOT NULL REFERENCES rose_db_object_colors (id), arb_attr VARCHAR(64), UNIQUE(obj_id, color_id) ) EOF $dbh->disconnect; # Create test subclasses package MyMySQLOtherObject; our @ISA = qw(Rose::DB::Object); our $DB; sub init_db { $DB ||= Rose::DB->new('mysql') } MyMySQLOtherObject->meta->table('rose_db_object_other'); MyMySQLOtherObject->meta->columns ( name => { type => 'varchar'}, k1 => { type => 'int' }, k2 => { type => 'int' }, k3 => { type => 'int' }, ); MyMySQLOtherObject->meta->primary_key_columns([ qw(k1 k2 k3) ]); MyMySQLOtherObject->meta->initialize; package MyMySQLObject; use Rose::DB::Object::Helpers qw(has_loaded_related); our @ISA = qw(Rose::DB::Object); our $DB; sub init_db { $DB ||= Rose::DB->new('mysql') } MyMySQLObject->meta->allow_inline_column_values(1); MyMySQLObject->meta->table('rose_db_object_test'); MyMySQLObject->meta->columns ( 'name', id => { primary_key => 1 }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, bits => { type => 'bitfield', bits => 5, default => 101 }, fk1 => { type => 'int' }, fk2 => { type => 'int' }, fk3 => { type => 'int' }, last_modified => { type => 'timestamp' }, date_created => { type => 'datetime' }, ); MyMySQLObject->meta->relationships ( other_obj => { type => 'many to one', class => 'MyMySQLOtherObject', column_map => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, required => 1, } ); MyMySQLObject->meta->add_relationships ( other_obj_otoo => { type => 'one to one', class => 'MyMySQLOtherObject', column_map => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, other_obj_osoft => { type => 'one to one', class => 'MyMySQLOtherObject', column_map => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, referential_integrity => 0, }, other_obj_msoft => { type => 'many to one', class => 'MyMySQLOtherObject', column_map => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, soft => 1, with_column_triggers => 1, }, other2_objs => { type => 'one to many', class => 'MyMySQLOtherObject2', column_map => { id => 'pid' }, manager_args => { sort_by => 'rose_db_object_other2.name DESC' }, methods => { get_set => undef, get_set_now => 'other2_objs_now', get_set_on_save => 'other2_objs_on_save', add_now => 'add_other2_objs_now', add_on_save => undef, }, }, other2_a_objs => { type => 'one to many', class => 'MyMySQLOtherObject2', column_map => { id => 'pid' }, query_args => [ name => { like => 'a%' } ], manager_args => { sort_by => 'name' }, }, other2_objs2 => { type => 'one to many', class => 'MyMySQLOtherObject2', column_map => { id => 'pid' }, }, ); MyMySQLObject->meta->foreign_keys ( other_obj => { class => 'MyMySQLOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, methods => { get_set_now => undef, get_set_on_save => 'other_obj_on_save', delete_now => undef, delete_on_save => 'del_other_obj_on_save', }, }, ); MyMySQLObject->meta->add_relationship ( colors => { type => 'many to many', map_class => 'MyMySQLColorMap', map_from => 'object', map_to => 'color', manager_args => { sort_by => 'rose_db_object_colors.name' }, methods => { get_set => undef, get_set_now => 'colors_now', get_set_on_save => 'colors_on_save', add_now => undef, add_on_save => 'add_colors_on_save', find => undef, count => undef, }, }, ); eval { MyMySQLObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method - mysql'); MyMySQLObject->meta->alias_column(save => 'save_col'); MyMySQLObject->meta->initialize(preserve_existing => 1); my $meta = MyMySQLObject->meta; Test::More::is($meta->relationship('other_obj')->foreign_key, $meta->foreign_key('other_obj'), 'foreign key sync 1 - mysql'); package MyMySQLOtherObject2; our @ISA = qw(Rose::DB::Object); our $DB; sub init_db { $DB ||= Rose::DB->new('mysql') } MyMySQLOtherObject2->meta->table('rose_db_object_other2'); MyMySQLOtherObject2->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar'}, pid => { type => 'int' }, ); MyMySQLOtherObject2->meta->relationships ( other_obj => { type => 'many to one', class => 'MyMySQLObject', column_map => { pid => 'id' }, required => 1, with_column_triggers => 1, }, ); MyMySQLOtherObject2->meta->foreign_keys ( other_obj => { class => 'MyMySQLObject', key_columns => { pid => 'id' }, }, ); MyMySQLOtherObject2->meta->initialize; package MyMySQLColor; our @ISA = qw(Rose::DB::Object); our $DB; sub init_db { $DB ||= Rose::DB->new('mysql') } MyMySQLColor->meta->table('rose_db_object_colors'); MyMySQLColor->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', not_null => 1 }, ); MyMySQLColor->meta->initialize; package MyMySQLColorMap; our @ISA = qw(Rose::DB::Object); our $DB; sub init_db { $DB ||= Rose::DB->new('mysql') } MyMySQLColorMap->meta->table('rose_db_object_colors_map'); MyMySQLColorMap->meta->columns ( id => { type => 'serial', primary_key => 1 }, obj_id => { type => 'int', not_null => 1 }, color_id => { type => 'int', not_null => 1 }, ); MyMySQLColorMap->meta->unique_keys([ 'obj_id', 'color_id' ]); MyMySQLColorMap->meta->foreign_keys ( object => { class => 'MyMySQLObject', key_columns => { obj_id => 'id' }, }, color => { class => 'MyMySQLColor', key_columns => { color_id => 'id' }, }, ); MyMySQLColorMap->meta->initialize; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_INFORMIX = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->do('DROP TABLE rose_db_object_colors_map CASCADE'); $dbh->do('DROP TABLE rose_db_object_colors'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->do('DROP TABLE rose_db_object_other2'); $dbh->do('DROP TABLE rose_db_object_chkpass_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32), UNIQUE(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits VARCHAR(5) DEFAULT '00101' NOT NULL, start DATE, save INT, nums VARCHAR(255), fk1 INT, fk2 INT, fk3 INT, last_modified DATETIME YEAR TO FRACTION(5), date_created DATETIME YEAR TO FRACTION(5), FOREIGN KEY (fk1, fk2, fk3) REFERENCES rose_db_object_other (k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other2 ( id INT NOT NULL PRIMARY KEY, name VARCHAR(255), pid INT NOT NULL REFERENCES rose_db_object_test (id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_colors ( id SERIAL PRIMARY KEY, name VARCHAR(255) NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_colors_map ( id SERIAL PRIMARY KEY, obj_id INT NOT NULL REFERENCES rose_db_object_test (id), color_id INT NOT NULL REFERENCES rose_db_object_colors (id), arb_attr VARCHAR(64), UNIQUE(obj_id, color_id) ) EOF $dbh->disconnect; # Create test subclasses package MyInformixOtherObject; our @ISA = qw(Rose::DB::Object); our $DB; sub init_db { $DB ||= Rose::DB->new('informix') } MyInformixOtherObject->meta->table('rose_db_object_other'); MyInformixOtherObject->meta->columns ( name => { type => 'varchar'}, k1 => { type => 'int' }, k2 => { type => 'int' }, k3 => { type => 'int' }, ); MyInformixOtherObject->meta->primary_key_columns(qw(k1 k2 k3)); MyInformixOtherObject->meta->initialize; package MyInformixObject; use Rose::DB::Object::Helpers qw(has_loaded_related); our @ISA = qw(Rose::DB::Object); our $DB; sub init_db { $DB ||= Rose::DB->new('informix') } MyInformixObject->meta->table('rose_db_object_test'); MyInformixObject->meta->dbi_prepare_cached(0); MyInformixObject->meta->columns ( 'name', id => { primary_key => 1 }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, nums => { type => 'array' }, bits => { type => 'bitfield', bits => 5, default => 101 }, fk1 => { type => 'int' }, fk2 => { type => 'int' }, fk3 => { type => 'int' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); MyInformixObject->meta->add_foreign_keys ( other_obj => { class => 'MyInformixOtherObject', rel_type => 'one to one', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, methods => { get_set_now => undef, get_set_on_save => 'other_obj_on_save', delete_now => undef, delete_on_save => 'del_other_obj_on_save', }, }, ); MyInformixObject->meta->add_relationships ( other_obj_osoft => { type => 'one to one', class => 'MyInformixOtherObject', column_map => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, referential_integrity => 0, }, other_obj_msoft => { type => 'many to one', class => 'MyInformixOtherObject', column_map => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, soft => 1, with_column_triggers => 1, }, other2_objs => { type => 'one to many', class => 'MyInformixOtherObject2', column_map => { id => 'pid' }, manager_args => { sort_by => 'rose_db_object_other2.name DESC' }, methods => { get_set => undef, get_set_now => 'other2_objs_now', get_set_on_save => 'other2_objs_on_save', add_now => 'add_other2_objs_now', add_on_save => undef, }, }, other2_a_objs => { type => 'one to many', class => 'MyInformixOtherObject2', column_map => { id => 'pid' }, query_args => [ name => { like => 'a%' } ], manager_args => { sort_by => 'name' }, }, ); MyInformixObject->meta->alias_column(fk1 => 'fkone'); MyInformixObject->meta->add_relationship ( colors => { type => 'many to many', map_class => 'MyInformixColorMap', #map_from => 'object', #map_to => 'color', manager_args => { sort_by => 'rose_db_object_colors.name' }, methods => { get_set => undef, get_set_now => 'colors_now', get_set_on_save => 'colors_on_save', add_now => undef, add_on_save => 'add_colors_on_save', find => undef, count => undef, }, }, ); eval { MyInformixObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method - informix'); MyInformixObject->meta->alias_column(save => 'save_col'); MyInformixObject->meta->initialize(preserve_existing => 1); my $meta = MyInformixObject->meta; Test::More::is($meta->relationship('other_obj')->foreign_key, $meta->foreign_key('other_obj'), 'foreign key sync 1 - Informix'); package MyInformixOtherObject2; our @ISA = qw(Rose::DB::Object); our $DB; sub init_db { $DB ||= Rose::DB->new('informix') } MyInformixOtherObject2->meta->table('rose_db_object_other2'); MyInformixOtherObject2->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar'}, pid => { type => 'int' }, ); MyInformixOtherObject2->meta->relationships ( other_obj => { type => 'many to one', class => 'MyInformixObject', column_map => { pid => 'id' }, required => 1, with_column_triggers => 1, }, ); MyInformixOtherObject2->meta->foreign_keys ( other_obj => { class => 'MyInformixObject', key_columns => { pid => 'id' }, }, ); MyInformixOtherObject2->meta->initialize; package MyInformixColor; our @ISA = qw(Rose::DB::Object); our $DB; sub init_db { $DB ||= Rose::DB->new('informix') } MyInformixColor->meta->table('rose_db_object_colors'); MyInformixColor->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', not_null => 1 }, ); MyInformixColor->meta->initialize; package MyInformixColorMap; our @ISA = qw(Rose::DB::Object); our $DB; sub init_db { $DB ||= Rose::DB->new('informix') } MyInformixColorMap->meta->table('rose_db_object_colors_map'); MyInformixColorMap->meta->columns ( id => { type => 'serial', primary_key => 1 }, obj_id => { type => 'int', not_null => 1 }, color_id => { type => 'int', not_null => 1 }, ); MyInformixColorMap->meta->unique_keys([ 'obj_id', 'color_id' ]); MyInformixColorMap->meta->foreign_keys ( object => { class => 'MyInformixObject', key_columns => { obj_id => 'id' }, }, color => { class => 'MyInformixColor', key_columns => { color_id => 'id' }, }, ); MyInformixColorMap->meta->initialize; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_SQLITE = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_colors_map'); $dbh->do('DROP TABLE rose_db_object_colors'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->do('DROP TABLE rose_db_object_other2'); $dbh->do('DROP TABLE rose_db_object_chkpass_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32), UNIQUE(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits VARCHAR(5) DEFAULT '00101' NOT NULL, start DATE, save INT, nums VARCHAR(255), fk1 INT, fk2 INT, fk3 INT, last_modified DATETIME, date_created DATETIME, FOREIGN KEY (fk1, fk2, fk3) REFERENCES rose_db_object_other (k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other2 ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255), pid INT NOT NULL REFERENCES rose_db_object_test (id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_colors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_colors_map ( id INTEGER PRIMARY KEY AUTOINCREMENT, obj_id INT NOT NULL REFERENCES rose_db_object_test (id), color_id INT NOT NULL REFERENCES rose_db_object_colors (id), arb_attr VARCHAR(64), UNIQUE(obj_id, color_id) ) EOF $dbh->disconnect; # Create test subclasses package MySQLiteOtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MySQLiteOtherObject->meta->table('rose_db_object_other'); MySQLiteOtherObject->meta->columns ( name => { type => 'varchar'}, k1 => { type => 'int' }, k2 => { type => 'int' }, k3 => { type => 'int' }, ); MySQLiteOtherObject->meta->primary_key_columns(qw(k1 k2 k3)); MySQLiteOtherObject->meta->initialize; package MySQLiteObject; use Rose::DB::Object::Helpers qw(has_loaded_related); our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MySQLiteObject->meta->table('rose_db_object_test'); MySQLiteObject->meta->columns ( 'name', id => { primary_key => 1 }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, nums => { type => 'array' }, bits => { type => 'bitfield', bits => 5, default => 101 }, fk1 => { type => 'int' }, fk2 => { type => 'int' }, fk3 => { type => 'int' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); MySQLiteObject->meta->add_foreign_keys ( other_obj => { class => 'MySQLiteOtherObject', rel_type => 'one to one', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, methods => { get_set_now => undef, get_set_on_save => 'other_obj_on_save', delete_now => undef, delete_on_save => 'del_other_obj_on_save', }, }, ); MySQLiteObject->meta->add_relationships ( other_obj_osoft => { type => 'one to one', class => 'MySQLiteOtherObject', column_map => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, soft => 1, }, other_obj_msoft => { type => 'many to one', class => 'MySQLiteOtherObject', column_map => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, referential_integrity => 0, with_column_triggers => 1, }, other2_objs => { type => 'one to many', class => 'MySQLiteOtherObject2', column_map => { id => 'pid' }, manager_args => { sort_by => 'rose_db_object_other2.name DESC' }, methods => { find => undef, iterator => undef, get_set => undef, get_set_now => 'other2_objs_now', get_set_on_save => 'other2_objs_on_save', add_now => 'add_other2_objs_now', add_on_save => undef, }, }, other2_a_objs => { type => 'one to many', class => 'MySQLiteOtherObject2', column_map => { id => 'pid' }, query_args => [ name => { like => 'a%' } ], manager_args => { sort_by => 'name' }, }, other2_one_obj => { type => 'one to one', class => 'MySQLiteOtherObject2', column_map => { id => 'pid' }, query_args => [ name => 'one' ], with_column_triggers => 1, }, other2_objs2 => { type => 'one to many', class => 'MySQLiteOtherObject2', column_map => { id => 'pid' }, }, # Hrm. Experimental... not_other2_objs => { type => 'one to many', class => 'MySQLiteOtherObject2', #column_map => { id => 'pid' }, query_args => [ id => { ne_sql => 'pid' } ], }, ); MySQLiteObject->meta->alias_column(fk1 => 'fkone'); MySQLiteObject->meta->add_relationship ( colors => { type => 'many to many', map_class => 'MySQLiteColorMap', #map_from => 'object', #map_to => 'color', manager_args => { sort_by => 'name' }, methods => { get_set => undef, get_set_now => 'colors_now', get_set_on_save => 'colors_on_save', add_now => undef, add_on_save => 'add_colors_on_save', find => undef, count => undef, iterator => undef, }, }, colors2 => { type => 'many to many', map_class => 'MySQLiteColorMap', manager_args => { sort_by => 'name', with_map_records => 1 }, }, colors3 => { type => 'many to many', map_class => 'MySQLiteColorMap', manager_args => { sort_by => 'rose_db_object_colors_map.color_id DESC', with_map_records => 'map_rec' }, }, ); # Test to confirm a 0.780 fix for a bug in delete_relationships() MySQLiteObject->meta->delete_relationships; MySQLiteObject->meta->add_relationships ( other_obj_osoft => { type => 'one to one', class => 'MySQLiteOtherObject', column_map => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, soft => 1, }, other_obj_msoft => { type => 'many to one', class => 'MySQLiteOtherObject', column_map => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, referential_integrity => 0, with_column_triggers => 1, }, other2_objs => { type => 'one to many', class => 'MySQLiteOtherObject2', column_map => { id => 'pid' }, manager_args => { sort_by => 'rose_db_object_other2.name DESC' }, methods => { find => undef, iterator => undef, get_set => undef, get_set_now => 'other2_objs_now', get_set_on_save => 'other2_objs_on_save', add_now => 'add_other2_objs_now', add_on_save => undef, }, }, other2_a_objs => { type => 'one to many', class => 'MySQLiteOtherObject2', column_map => { id => 'pid' }, query_args => [ name => { like => 'a%' } ], manager_args => { sort_by => 'name' }, }, other2_one_obj => { type => 'one to one', class => 'MySQLiteOtherObject2', column_map => { id => 'pid' }, query_args => [ name => 'one' ], with_column_triggers => 1, }, other2_objs2 => { type => 'one to many', class => 'MySQLiteOtherObject2', column_map => { id => 'pid' }, }, # Hrm. Experimental... not_other2_objs => { type => 'one to many', class => 'MySQLiteOtherObject2', #column_map => { id => 'pid' }, query_args => [ id => { ne_sql => 'pid' } ], }, # manager_*_methods custom_manager_method_other2_objs => { type => 'one to many', class => 'MySQLiteOtherObject2', manager_class => 'MySQLiteOtherObject2::Manager', manager_method => 'other2_objs', manager_count_method => 'other2_objs_count', manager_iterator_method => 'other2_objs_iterator', manager_find_method => 'other2_objs_find', column_map => { id => 'pid' }, methods => { count => undef, find => undef, iterator => undef, get_set => undef, get_set_now => undef, get_set_on_save => undef, }, }, custom_manager_method_other_obj_msoft => { type => 'many to one', class => 'MySQLiteOtherObject', column_map => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, referential_integrity => 0, with_column_triggers => 1, manager_class => 'MySQLiteOtherObject::Manager', manager_delete_method => 'other_obj_delete', # TODO this not yet exercised }, ); MySQLiteObject->meta->alias_column(fk1 => 'fkone'); MySQLiteObject->meta->add_relationship ( colors => { type => 'many to many', map_class => 'MySQLiteColorMap', #map_from => 'object', #map_to => 'color', manager_args => { sort_by => 'name' }, methods => { get_set => undef, get_set_now => 'colors_now', get_set_on_save => 'colors_on_save', add_now => undef, add_on_save => 'add_colors_on_save', find => undef, count => undef, iterator => undef, }, }, colors2 => { type => 'many to many', map_class => 'MySQLiteColorMap', manager_args => { sort_by => 'name', with_map_records => 1 }, }, colors3 => { type => 'many to many', map_class => 'MySQLiteColorMap', manager_args => { sort_by => 'rose_db_object_colors_map.color_id DESC', with_map_records => 'map_rec' }, }, ); eval { MySQLiteObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method - sqlite'); MySQLiteObject->meta->alias_column(save => 'save_col'); MySQLiteObject->meta->initialize(preserve_existing => 1); my $meta = MySQLiteObject->meta; Test::More::is($meta->relationship('other_obj')->foreign_key, $meta->foreign_key('other_obj'), 'foreign key sync 1 - SQLite'); package MySQLiteOtherObject2; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MySQLiteOtherObject2->meta->table('rose_db_object_other2'); MySQLiteOtherObject2->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar'}, pid => { type => 'int' }, ); MySQLiteOtherObject2->meta->relationships ( other_obj => { type => 'many to one', class => 'MySQLiteObject', column_map => { pid => 'id' }, required => 1, with_column_triggers => 1, }, ); MySQLiteOtherObject2->meta->foreign_keys ( other_obj => { class => 'MySQLiteObject', key_columns => { pid => 'id' }, }, ); MySQLiteOtherObject2->meta->initialize; # Manager used only for custom manager_*_methods package MySQLiteOtherObject2::Manager; sub other2_objs { 'ima-get-objects' } sub other2_objs_count { 'ima-count' } sub other2_objs_iterator { 'ima-iterator' } sub other2_objs_find { 'ima-find' } package MySQLiteOtherObject::Manager; sub other_obj_delete { 'ima-delete' } # TODO this not yet exercised package MySQLiteColor; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MySQLiteColor->meta->table('rose_db_object_colors'); MySQLiteColor->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', not_null => 1 }, ); MySQLiteColor->meta->initialize; package MySQLiteColorMap; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MySQLiteColorMap->meta->table('rose_db_object_colors_map'); MySQLiteColorMap->meta->columns ( id => { type => 'serial', primary_key => 1 }, obj_id => { type => 'int', not_null => 1 }, color_id => { type => 'int', not_null => 1 }, arb_attr => { type => 'varchar', length => 64 }, ); MySQLiteColorMap->meta->unique_keys([ 'obj_id', 'color_id' ]); MySQLiteColorMap->meta->foreign_keys ( object => { class => 'MySQLiteObject', key_columns => { obj_id => 'id' }, }, color => { class => 'MySQLiteColor', key_columns => { color_id => 'id' }, }, ); MySQLiteColorMap->meta->initialize; } } sub test_meta { my($meta, $prefix, $db_type) = @_; $meta->delete_relationships; $meta->delete_foreign_keys; $meta->foreign_keys ( other_obj => { class => "${prefix}Object", key_columns => { pid => 'id' }, }, ); $meta->relationships ( other_objx => { type => 'many to one', class => "${prefix}Object", column_map => { pid => 'id' }, required => 1, with_column_triggers => 1, }, ); is(scalar @{$meta->foreign_keys}, 1, "proxy relationships 1 - $db_type"); is(scalar @{$meta->relationships}, 2, "proxy relationships 2 - $db_type"); $meta->delete_foreign_keys; is(scalar @{$meta->foreign_keys}, 0, "proxy relationships 3 - $db_type"); is(scalar @{$meta->relationships}, 1, "proxy relationships 4 - $db_type"); $meta->relationships ( other_objx => { type => 'many to one', class => "${prefix}Object", column_map => { pid => 'id' }, required => 1, with_column_triggers => 1, }, ); $meta->foreign_keys ( other_obj => { class => "${prefix}Object", key_columns => { pid => 'id' }, }, ); is(scalar @{$meta->foreign_keys}, 1, "proxy relationships 5 - $db_type"); is(scalar @{$meta->relationships}, 2, "proxy relationships 6 - $db_type"); } END { # Delete test table if($HAVE_PG) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->do('DROP TABLE rose_db_object_colors_map CASCADE'); $dbh->do('DROP TABLE rose_db_object_colors'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->do('DROP TABLE rose_db_object_other2'); $dbh->disconnect; } if($HAVE_MYSQL) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_colors_map CASCADE'); $dbh->do('DROP TABLE rose_db_object_colors'); $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->do('DROP TABLE rose_db_object_other2'); $dbh->disconnect; } if($HAVE_INFORMIX) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_colors_map CASCADE'); $dbh->do('DROP TABLE rose_db_object_colors'); $dbh->do('DROP TABLE rose_db_object_test CASCADE'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->do('DROP TABLE rose_db_object_other2'); $dbh->disconnect; } if($HAVE_SQLITE) { # SQLite my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_colors_map'); $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_colors'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->do('DROP TABLE rose_db_object_other2'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-std-cached.t000755 000765 000120 00000056110 12054157213 020470 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 241; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Std::Cached'); } our($PG_HAS_CHKPASS, $HAVE_PG, $HAVE_MYSQL, $HAVE_INFORMIX, $HAVE_SQLITE); # # PostgreSQL # SKIP: foreach my $db_type (qw(pg pg_with_schema)) { skip("PostgreSQL tests", 117) unless($HAVE_PG); Rose::DB->default_type($db_type); my $of = MyPgObject->new(name => 'John'); ok(ref $of && $of->isa('MyPgObject'), 'cached new() 1'); ok($of->save, 'save() 1'); my $of2 = MyPgObject->new(id => $of->id); ok(ref $of2 && $of2->isa('MyPgObject'), 'cached new() 2'); ok($of2->load, 'cached load()'); is($of2->name, $of->name, 'load() verify 1'); my $of3 = MyPgObject->new(id => $of2->id); ok(ref $of3 && $of3->isa('MyPgObject'), 'cached new() 3'); ok($of3->load, 'cached load()'); is($of3->name, $of2->name, 'cached load() verify 2'); is($of3, $of2, 'load() verify cached 1'); is($of2, $of, 'load() verify cached 2'); is(keys %MyPgObject::Objects_By_Id, 1, 'cache check 1'); ok($of->forget, 'forget()'); is(keys %MyPgObject::Objects_By_Id, 0, 'cache check 2'); # Standard tests my $o = MyPgObject->new(name => 'John'); ok(ref $o && $o->isa('MyPgObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(7); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); my $o2 = MyPgObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyPgObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 7, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified eq $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyPgObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyPgObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->load, "load() 4 - $db_type"); SKIP: { if($PG_HAS_CHKPASS) { $o->{'password_encrypted'} = ':8R1Kf2nOS0bRE'; ok($o->password_is('xyzzy'), "chkpass() 1 - $db_type"); is($o->password, 'xyzzy', "chkpass() 2 - $db_type"); $o->password('foobar'); ok($o->password_is('foobar'), "chkpass() 3 - $db_type"); is($o->password, 'foobar', "chkpass() 4 - $db_type"); ok($o->save, "save() 3 - $db_type"); } else { skip("chkpass tests", 5); } } my $o5 = MyPgObject->new(id => $o->id); ok($o5->load, "load() 5 - $db_type"); SKIP: { if($PG_HAS_CHKPASS) { ok($o5->password_is('foobar'), "chkpass() 5 - $db_type"); is($o5->password, 'foobar', "chkpass() 6 - $db_type"); } else { skip("chkpass tests", 2); } } $o5->nums([ 4, 5, 6 ]); ok($o5->save, "save() 4 - $db_type"); ok($o->load, "load() 6 - $db_type"); is($o5->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o5->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o5->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o5->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 6 (array value) - $db_type"); ok($o->delete, "delete() - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, 'alias_column() nonesuch'); $o2->forget; } # # MySQL # SKIP: foreach my $db_type ('mysql') { skip("MySQL tests", 41) unless($HAVE_MYSQL); Rose::DB->default_type($db_type); my $of = MyMySQLObject->new(name => 'John'); ok(ref $of && $of->isa('MyMySQLObject'), 'cached new() 1'); ok($of->save, 'save() 1'); my $of2 = MyMySQLObject->new(id => $of->id); ok(ref $of2 && $of2->isa('MyMySQLObject'), 'cached new() 2'); ok($of2->load, 'cached load()'); is($of2->name, $of->name, 'load() verify 1'); my $of3 = MyMySQLObject->new(id => $of2->id); ok(ref $of3 && $of3->isa('MyMySQLObject'), 'cached new() 3'); ok($of3->load, 'cached load()'); is($of3->name, $of2->name, 'cached load() verify 2'); is($of3, $of2, 'load() verify cached 1'); is($of2, $of, 'load() verify cached 2'); is(keys %MyMySQLObject::Objects_By_Id, 1, 'cache check 1'); ok($of->forget, 'forget()'); is(keys %MyMySQLObject::Objects_By_Id, 0, 'cache check 2'); # Standard tests my $o = MyMySQLObject->new(name => 'John'); ok(ref $o && $o->isa('MyMySQLObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(22); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); my $o2 = MyMySQLObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyMySQLObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 22, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified eq $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyMySQLObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyMySQLObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->delete, "delete() - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, 'alias_column() nonesuch'); } # # Informix # SKIP: foreach my $db_type ('informix') { skip("Informix tests", 41) unless($HAVE_INFORMIX); Rose::DB->default_type($db_type); my $of = MyInformixObject->new(name => 'John'); ok(ref $of && $of->isa('MyInformixObject'), 'cached new() 1'); ok($of->save, 'save() 1'); my $of2 = MyInformixObject->new(id => $of->id); ok(ref $of2 && $of2->isa('MyInformixObject'), 'cached new() 2'); ok($of2->load, 'cached load()'); is($of2->name, $of->name, 'load() verify 1'); my $of3 = MyInformixObject->new(id => $of2->id); ok(ref $of3 && $of3->isa('MyInformixObject'), 'cached new() 3'); ok($of3->load, 'cached load()'); is($of3->name, $of2->name, 'cached load() verify 2'); is($of3, $of2, 'load() verify cached 1'); is($of2, $of, 'load() verify cached 2'); is(keys %MyInformixObject::Objects_By_Id, 1, 'cache check 1'); ok($of->forget, 'forget()'); is(keys %MyInformixObject::Objects_By_Id, 0, 'cache check 2'); # Standard tests my $o = MyInformixObject->new(name => 'John'); ok(ref $o && $o->isa('MyInformixObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(22); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); my $o2 = MyInformixObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyInformixObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 22, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified eq $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyInformixObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyInformixObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->delete, "delete() - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, 'alias_column() nonesuch'); } # # SQLite # SKIP: foreach my $db_type ('sqlite') { skip("SQLite tests", 41) unless($HAVE_SQLITE); Rose::DB->default_type($db_type); my $of = MySQLiteObject->new(name => 'John'); ok(ref $of && $of->isa('MySQLiteObject'), 'cached new() 1'); ok($of->save, 'save() 1'); my $of2 = MySQLiteObject->new(id => $of->id); ok(ref $of2 && $of2->isa('MySQLiteObject'), 'cached new() 2'); ok($of2->load, 'cached load()'); is($of2->name, $of->name, 'load() verify 1'); my $of3 = MySQLiteObject->new(id => $of2->id); ok(ref $of3 && $of3->isa('MySQLiteObject'), 'cached new() 3'); ok($of3->load, 'cached load()'); is($of3->name, $of2->name, 'cached load() verify 2'); is($of3, $of2, 'load() verify cached 1'); is($of2, $of, 'load() verify cached 2'); is(keys %MySQLiteObject::Objects_By_Id, 1, 'cache check 1'); ok($of->forget, 'forget()'); is(keys %MySQLiteObject::Objects_By_Id, 0, 'cache check 2'); # Standard tests my $o = MySQLiteObject->new(name => 'John'); ok(ref $o && $o->isa('MySQLiteObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(22); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); my $o2 = MySQLiteObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MySQLiteObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 22, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified eq $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MySQLiteObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MySQLiteObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->delete, "delete() - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, 'alias_column() nonesuch'); } BEGIN { # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_PG = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_private.rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_chkpass_test'); $dbh->do('CREATE SCHEMA rose_db_object_private'); } our $PG_HAS_CHKPASS = pg_has_chkpass(); $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, @{[ $PG_HAS_CHKPASS ? 'password CHKPASS,' : '' ]} name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits BIT(5) NOT NULL DEFAULT B'00101', start DATE, save INT, nums INT[], last_modified TIMESTAMP NOT NULL DEFAULT 'now', date_created TIMESTAMP NOT NULL DEFAULT 'now' ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_private.rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, @{[ $PG_HAS_CHKPASS ? 'password CHKPASS,' : '' ]} name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits BIT(5) NOT NULL DEFAULT B'00101', start DATE, save INT, nums INT[], last_modified TIMESTAMP NOT NULL DEFAULT 'now', date_created TIMESTAMP NOT NULL DEFAULT 'now' ) EOF $dbh->disconnect; # Create test subclass package MyPgObject; our @ISA = qw(Rose::DB::Object::Std::Cached); sub init_db { Rose::DB->new('pg') } MyPgObject->meta->table('rose_db_object_test'); MyPgObject->meta->columns ( 'name', id => { primary_key => 1 }, ($PG_HAS_CHKPASS ? (password => { type => 'chkpass' }) : ()), flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, nums => { type => 'array' }, bits => { type => 'bitfield', bits => 5, default => 101 }, last_modified => { type => 'timestamp', default => 'now' }, date_created => { type => 'timestamp', default => 'now' }, ); eval { MyPgObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MyPgObject->meta->alias_column(save => 'save_col'); MyPgObject->meta->initialize(preserve_existing => 1); } # # MySQL # my $db_version; eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh() or die Rose::DB->error; $db_version = $db->database_version; }; if(!$@ && $dbh) { our $HAVE_MYSQL = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } # MySQL 5.0.3 or later has a completely stupid "native" BIT type my $bit_col = ($db_version >= 5_000_003) ? q(bits BIT(5) NOT NULL DEFAULT B'00101') : q(bits BIT(5) NOT NULL DEFAULT '00101'); $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, name VARCHAR(32) NOT NULL, flag TINYINT(1) NOT NULL, flag2 TINYINT(1), status VARCHAR(32) DEFAULT 'active', $bit_col, start DATE, save INT, last_modified TIMESTAMP, date_created DATETIME ) EOF $dbh->disconnect; # Create test subclass package MyMySQLObject; our @ISA = qw(Rose::DB::Object::Std::Cached); sub init_db { Rose::DB->new('mysql') } MyMySQLObject->meta->allow_inline_column_values(1); MyMySQLObject->meta->table('rose_db_object_test'); MyMySQLObject->meta->columns ( 'name', id => { primary_key => 1 }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, bits => { type => 'bitfield', bits => 5, default => 101 }, last_modified => { type => 'timestamp' }, date_created => { type => 'datetime' }, ); eval { MyMySQLObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MyMySQLObject->meta->alias_column(save => 'save_col'); MyMySQLObject->meta->initialize(preserve_existing => 1); } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_INFORMIX = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits VARCHAR(5) DEFAULT '00101' NOT NULL, start DATE, save INT, last_modified DATETIME YEAR TO FRACTION(5), date_created DATETIME YEAR TO FRACTION(5) ) EOF $dbh->disconnect; # Create test subclass package MyInformixObject; our @ISA = qw(Rose::DB::Object::Std::Cached); sub init_db { Rose::DB->new('informix') } MyInformixObject->meta->table('rose_db_object_test'); MyInformixObject->meta->columns ( 'name', id => { primary_key => 1 }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, bits => { type => 'bitfield', bits => 5, default => 101 }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); eval { MyInformixObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MyInformixObject->meta->alias_column(save => 'save_col'); MyInformixObject->meta->initialize(preserve_existing => 1); } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_SQLITE = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits VARCHAR(5) DEFAULT '00101' NOT NULL, start DATE, save INT, last_modified TIMESTAMP, date_created TIMESTAMP ) EOF $dbh->disconnect; # Create test subclass package MySQLiteObject; our @ISA = qw(Rose::DB::Object::Std::Cached); sub init_db { Rose::DB->new('sqlite') } MySQLiteObject->meta->table('rose_db_object_test'); MySQLiteObject->meta->columns ( 'name', id => { primary_key => 1 }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, bits => { type => 'bitfield', bits => 5, default => 101 }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); eval { MySQLiteObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MySQLiteObject->meta->alias_column(save => 'save_col'); MySQLiteObject->meta->initialize(preserve_existing => 1); } } END { # Delete test table if($HAVE_PG) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_private.rose_db_object_test'); $dbh->do('DROP SCHEMA rose_db_object_private'); $dbh->disconnect; } if($HAVE_MYSQL) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } if($HAVE_INFORMIX) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } if($HAVE_SQLITE) { # SQLite my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object-std.t000755 000765 000120 00000053127 12054157213 017270 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 185; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Std'); use_ok('Rose::DB::Object::MakeMethods::Std'); } our($PG_HAS_CHKPASS, $HAVE_PG, $HAVE_MYSQL, $HAVE_INFORMIX, $HAVE_SQLITE); # # PostgreSQL # SKIP: foreach my $db_type (qw(pg pg_with_schema)) { skip("PostgreSQL tests", 99) unless($HAVE_PG); Rose::DB->default_type($db_type); my $o = MyPgObject->new(name => 'John'); ok(ref $o && $o->isa('MyPgObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(7); $o->other_id(1); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); my $o2 = MyPgObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyPgObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 7, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyPgObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyPgObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->load, "load() 4 - $db_type"); SKIP: { if($PG_HAS_CHKPASS) { $o->{'password_encrypted'} = ':8R1Kf2nOS0bRE'; ok($o->password_is('xyzzy'), "chkpass() 1 - $db_type"); is($o->password, 'xyzzy', "chkpass() 2 - $db_type"); $o->password('foobar'); ok($o->password_is('foobar'), "chkpass() 3 - $db_type"); is($o->password, 'foobar', "chkpass() 4 - $db_type"); ok($o->save, "save() 3 - $db_type"); } else { skip("chkpass tests", 5); } } my $o5 = MyPgObject->new(id => $o->id); ok($o5->load, "load() 5 - $db_type"); SKIP: { if($PG_HAS_CHKPASS) { ok($o5->password_is('foobar'), "chkpass() 5 - $db_type"); is($o5->password, 'foobar', "chkpass() 6 - $db_type"); } else { skip("chkpass tests", 2); } } $o5->nums([ 4, 5, 6 ]); ok($o5->save, "save() 4 - $db_type"); ok($o->load, "load() 6 - $db_type"); is($o5->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o5->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o5->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o5->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); my $other = $o->other; is(ref $other, 'MyPgObjectOther', 'object_by_id 1'); is($other->name, 'John', 'object_by_id 2'); ok($o->delete, "delete() - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, 'alias_column() nonesuch'); my($new_id, $old_id); $old_id = $o->id; eval { $new_id = $o->meta->generate_primary_key_value($o->db) }; ok(defined $new_id && $new_id > $o->id, 'generate_primary_key_value()'); $old_id = $new_id; eval { ($new_id) = $o->meta->generate_primary_key_values($o->db) }; ok(defined $new_id && $new_id > $o->id, 'generate_primary_key_values()'); } # # MySQL # SKIP: foreach my $db_type ('mysql') { skip("MySQL tests", 28) unless($HAVE_MYSQL); Rose::DB->default_type($db_type); my $o = MyMySQLObject->new(name => 'John'); ok(ref $o && $o->isa('MyMySQLObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(22); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); my $o2 = MyMySQLObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyMySQLObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 22, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyMySQLObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyMySQLObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->delete, "delete() - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, 'alias_column() nonesuch'); } # # Informix # SKIP: foreach my $db_type ('informix') { skip("Informix tests", 28) unless($HAVE_INFORMIX); Rose::DB->default_type($db_type); my $o = MyInformixObject->new(name => 'John'); ok(ref $o && $o->isa('MyInformixObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(22); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); my $o2 = MyInformixObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyInformixObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 22, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyInformixObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyInformixObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->delete, "delete() - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, 'alias_column() nonesuch'); } # # SQLite # SKIP: foreach my $db_type ('sqlite') { skip("Informix tests", 28) unless($HAVE_SQLITE); Rose::DB->default_type($db_type); my $o = MySQLiteObject->new(name => 'John'); ok(ref $o && $o->isa('MySQLiteObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(22); ok($o->save, "save() 1 - $db_type"); ok($o->load, "load() 1 - $db_type"); my $o2 = MySQLiteObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MySQLiteObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 22, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MySQLiteObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MySQLiteObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->delete, "delete() - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, 'alias_column() nonesuch'); } BEGIN { # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_PG = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->do('DROP TABLE rose_db_object_private.rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_private.rose_db_object_other'); $dbh->do('DROP TABLE rose_db_object_chkpass_test'); $dbh->do('CREATE SCHEMA rose_db_object_private'); } our $PG_HAS_CHKPASS = pg_has_chkpass(); $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, @{[ $PG_HAS_CHKPASS ? 'password CHKPASS,' : '' ]} name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits BIT(5) NOT NULL DEFAULT B'00101', start DATE, save INT, nums INT[], other_id INT, last_modified TIMESTAMP NOT NULL DEFAULT 'now', date_created TIMESTAMP NOT NULL DEFAULT 'now' ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other ( id SERIAL PRIMARY KEY, name VARCHAR(32) NOT NULL ) EOF $dbh->do(<<"EOF"); INSERT INTO rose_db_object_other (id, name) VALUES (1, 'John') EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_private.rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, @{[ $PG_HAS_CHKPASS ? 'password CHKPASS,' : '' ]} name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits BIT(5) NOT NULL DEFAULT B'00101', start DATE, save INT, nums INT[], other_id INT, last_modified TIMESTAMP NOT NULL DEFAULT 'now', date_created TIMESTAMP NOT NULL DEFAULT 'now' ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_private.rose_db_object_other ( id SERIAL PRIMARY KEY, name VARCHAR(32) NOT NULL ) EOF $dbh->do(<<"EOF"); INSERT INTO rose_db_object_private.rose_db_object_other (id, name) VALUES (1, 'John') EOF $dbh->disconnect; # Create test subclasses package MyPgObjectOther; our @ISA = qw(Rose::DB::Object::Std); sub init_db { Rose::DB->new('pg') } MyPgObjectOther->meta->table('rose_db_object_other'); MyPgObjectOther->meta->columns ( id => { primary_key => 1 }, 'name', ); MyPgObjectOther->meta->initialize; package MyPgObject; our @ISA = qw(Rose::DB::Object::Std); sub init_db { Rose::DB->new('pg') } MyPgObject->meta->table('rose_db_object_test'); MyPgObject->meta->columns ( 'name', id => { primary_key => 1 }, ($PG_HAS_CHKPASS ? (password => { type => 'chkpass' }) : ()), flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, nums => { type => 'array' }, bits => { type => 'bitfield', bits => 5, default => 101 }, other_id => { type => 'int' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); Rose::DB::Object::MakeMethods::Std->import ( object_by_id => [ 'other' => { class => 'MyPgObjectOther' }, ], ); eval { MyPgObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MyPgObject->meta->alias_column(save => 'save_col'); MyPgObject->meta->initialize(preserve_existing => 1); } # # MySQL # my $db_version; eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh() or die Rose::DB->error; $db_version = $db->database_version; }; if(!$@ && $dbh) { our $HAVE_MYSQL = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } # MySQL 5.0.3 or later has a completely stupid "native" BIT type my $bit_col = ($db_version >= 5_000_003) ? q(bits BIT(5) NOT NULL DEFAULT B'00101') : q(bits BIT(5) NOT NULL DEFAULT '00101'); $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, name VARCHAR(32) NOT NULL, flag TINYINT(1) NOT NULL, flag2 TINYINT(1), status VARCHAR(32) DEFAULT 'active', $bit_col, start DATE, save INT, last_modified TIMESTAMP, date_created DATETIME ) EOF $dbh->disconnect; # Create test subclass package MyMySQLObject; our @ISA = qw(Rose::DB::Object::Std); sub init_db { Rose::DB->new('mysql') } MyMySQLObject->meta->allow_inline_column_values(1); MyMySQLObject->meta->table('rose_db_object_test'); MyMySQLObject->meta->columns ( 'name', id => { primary_key => 1 }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, bits => { type => 'bitfield', bits => 5, default => 101 }, last_modified => { type => 'timestamp' }, date_created => { type => 'datetime' }, ); eval { MyMySQLObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MyMySQLObject->meta->alias_column(save => 'save_col'); MyMySQLObject->meta->initialize(preserve_existing => 1); } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_INFORMIX = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits VARCHAR(5) DEFAULT '00101' NOT NULL, start DATE, save INT, last_modified DATETIME YEAR TO FRACTION(5), date_created DATETIME YEAR TO FRACTION(5) ) EOF $dbh->disconnect; # Create test subclass package MyInformixObject; our @ISA = qw(Rose::DB::Object::Std); sub init_db { Rose::DB->new('informix') } MyInformixObject->meta->table('rose_db_object_test'); MyInformixObject->meta->columns ( 'name', id => { primary_key => 1 }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, bits => { type => 'bitfield', bits => 5, default => 101 }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); eval { MyInformixObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MyInformixObject->meta->alias_column(save => 'save_col'); MyInformixObject->meta->initialize(preserve_existing => 1); } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_SQLITE = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bits VARCHAR(5) DEFAULT '00101' NOT NULL, start DATE, save INT, last_modified TIMESTAMP, date_created TIMESTAMP ) EOF $dbh->disconnect; # Create test subclass package MySQLiteObject; our @ISA = qw(Rose::DB::Object::Std); sub init_db { Rose::DB->new('sqlite') } MySQLiteObject->meta->table('rose_db_object_test'); MySQLiteObject->meta->columns ( 'name', id => { primary_key => 1 }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active' }, start => { type => 'date', default => '12/24/1980' }, save => { type => 'scalar' }, bits => { type => 'bitfield', bits => 5, default => 101 }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); eval { MySQLiteObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MySQLiteObject->meta->alias_column(save => 'save_col'); MySQLiteObject->meta->initialize(preserve_existing => 1); } } END { # Delete test table if($HAVE_PG) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->do('DROP TABLE rose_db_object_private.rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_private.rose_db_object_other'); $dbh->do('DROP SCHEMA rose_db_object_private CASCADE'); $dbh->disconnect; } if($HAVE_MYSQL) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } if($HAVE_INFORMIX) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } if($HAVE_SQLITE) { # SQLite my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/db-object.t000755 000765 000120 00000232537 12102776462 016513 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 598; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Util'); } Rose::DB::Object::Util->import(':all'); eval { require Time::HiRes }; our $Have_HiRes_Time = $@ ? 0 : 1; our($PG_HAS_CHKPASS, $HAVE_PG, $HAVE_MYSQL, $HAVE_INFORMIX, $HAVE_SQLITE, $HAVE_ORACLE, $INNODB); # # PostgreSQL # SKIP: foreach my $db_type (qw(pg pg_with_schema)) { skip("PostgreSQL tests", 242) unless($HAVE_PG); Rose::DB->default_type($db_type); TEST_HACK: { no warnings; *MyPgObject::init_db = sub { Rose::DB->new($db_type) }; } my $o = MyPgObject->new(name => 'John', k1 => 1, k2 => undef, k3 => 3); ok(ref $o && $o->isa('MyPgObject'), "new() 1 - $db_type"); $o->flag2('TRUE'); $o->date_created('now'); $o->date_created_tz('now'); $o->timestamp_tz2('now'); $o->last_modified($o->date_created); $o->save_col(7); if(rand >= 0.5) { ok($o->save, "save() 1 - $db_type"); } else { ok($o->insert, "insert() 1 - $db_type"); } MyPgObject->meta->sql_qualify_column_names_on_load(1); my $schema = $db_type eq 'pg_with_schema' ? 'rose_db_object_private.' : ''; is(MyPgObject->meta->load_all_sql(undef, $o->db), qq(SELECT rose_db_object_test.name, rose_db_object_test.code, rose_db_object_test.id, rose_db_object_test.k1, rose_db_object_test.k2, rose_db_object_test.k3,@{[ $PG_HAS_CHKPASS ? ' rose_db_object_test.passwd,' : '' ]} rose_db_object_test.flag, rose_db_object_test.flag2, rose_db_object_test.status, rose_db_object_test.start, rose_db_object_test.save, rose_db_object_test.nums, rose_db_object_test.bitz, rose_db_object_test.decs, rose_db_object_test.dur, rose_db_object_test.epoch, rose_db_object_test.hiepoch, rose_db_object_test.bint1, rose_db_object_test.bint2, rose_db_object_test.bint3, rose_db_object_test.bint4, rose_db_object_test.tee_time, rose_db_object_test.tee_time0, rose_db_object_test.tee_time5, rose_db_object_test.tee_time9, rose_db_object_test.date_created, rose_db_object_test.date_created_tz, rose_db_object_test.timestamp_tz2, rose_db_object_test.last_modified FROM ${schema}rose_db_object_test WHERE rose_db_object_test.id = ?), "sql_qualify_column_names_on_load() 1 - $db_type"); is(MyPgObject->meta->load_sql(undef, $o->db), qq(SELECT rose_db_object_test.name, rose_db_object_test.code, rose_db_object_test.id, rose_db_object_test.k1, rose_db_object_test.k3,@{[ $PG_HAS_CHKPASS ? ' rose_db_object_test.passwd,' : '' ]} rose_db_object_test.flag, rose_db_object_test.flag2, rose_db_object_test.status, rose_db_object_test.save, rose_db_object_test.nums, rose_db_object_test.bitz, rose_db_object_test.decs, rose_db_object_test.dur, rose_db_object_test.epoch, rose_db_object_test.hiepoch, rose_db_object_test.bint1, rose_db_object_test.bint2, rose_db_object_test.bint3, rose_db_object_test.bint4, rose_db_object_test.tee_time, rose_db_object_test.tee_time0, rose_db_object_test.tee_time5, rose_db_object_test.tee_time9, rose_db_object_test.date_created, rose_db_object_test.date_created_tz, rose_db_object_test.timestamp_tz2, rose_db_object_test.last_modified FROM ${schema}rose_db_object_test WHERE rose_db_object_test.id = ?), "sql_qualify_column_names_on_load() 2 - $db_type"); is(MyPgObject->meta->load_all_sql_with_null_key([ qw(k1 k2 k3) ], [ 1, undef, 3 ], $o->db), qq(SELECT rose_db_object_test.name, rose_db_object_test.code, rose_db_object_test.id, rose_db_object_test.k1, rose_db_object_test.k2, rose_db_object_test.k3,@{[ $PG_HAS_CHKPASS ? ' rose_db_object_test.passwd,' : '' ]} rose_db_object_test.flag, rose_db_object_test.flag2, rose_db_object_test.status, rose_db_object_test.start, rose_db_object_test.save, rose_db_object_test.nums, rose_db_object_test.bitz, rose_db_object_test.decs, rose_db_object_test.dur, rose_db_object_test.epoch, rose_db_object_test.hiepoch, rose_db_object_test.bint1, rose_db_object_test.bint2, rose_db_object_test.bint3, rose_db_object_test.bint4, rose_db_object_test.tee_time, rose_db_object_test.tee_time0, rose_db_object_test.tee_time5, rose_db_object_test.tee_time9, rose_db_object_test.date_created, rose_db_object_test.date_created_tz, rose_db_object_test.timestamp_tz2, rose_db_object_test.last_modified FROM ${schema}rose_db_object_test WHERE rose_db_object_test.k1 = ? AND rose_db_object_test.k2 IS NULL AND rose_db_object_test.k3 = ?), "sql_qualify_column_names_on_load() 3 - $db_type"); is(MyPgObject->meta->load_sql_with_null_key([ qw(k1 k2 k3) ], [ 1, undef, 3 ], $o->db), qq(SELECT rose_db_object_test.name, rose_db_object_test.code, rose_db_object_test.id, rose_db_object_test.k1, rose_db_object_test.k3,@{[ $PG_HAS_CHKPASS ? ' rose_db_object_test.passwd,' : '' ]} rose_db_object_test.flag, rose_db_object_test.flag2, rose_db_object_test.status, rose_db_object_test.save, rose_db_object_test.nums, rose_db_object_test.bitz, rose_db_object_test.decs, rose_db_object_test.dur, rose_db_object_test.epoch, rose_db_object_test.hiepoch, rose_db_object_test.bint1, rose_db_object_test.bint2, rose_db_object_test.bint3, rose_db_object_test.bint4, rose_db_object_test.tee_time, rose_db_object_test.tee_time0, rose_db_object_test.tee_time5, rose_db_object_test.tee_time9, rose_db_object_test.date_created, rose_db_object_test.date_created_tz, rose_db_object_test.timestamp_tz2, rose_db_object_test.last_modified FROM ${schema}rose_db_object_test WHERE rose_db_object_test.k1 = ? AND rose_db_object_test.k2 IS NULL AND rose_db_object_test.k3 = ?), "sql_qualify_column_names_on_load() 4 - $db_type"); MyPgObject->meta->sql_qualify_column_names_on_load(rand > 0.6 ? 0 : 1); # excitement! :) is($o->meta->primary_key->sequence_names->[0], 'rose_db_object_test_id_seq', "pk sequence name - $db_type"); ok(is_in_db($o), "is_in_db - $db_type"); is($o->id, 1, "auto-generated primary key - $db_type"); ok($o->load, "load() 1 - $db_type"); is($o->date_created->time_zone->name, 'floating', "timestamp without time zone - $db_type"); isnt($o->date_created_tz->time_zone->name, 'floating', "timestamp with time zone - $db_type"); is($o->timestamp_tz2->time_zone->name, 'Antarctica/Vostok', "timestamp with time zone override - $db_type"); # Make sure we're not in the Antarctica/Vostok time zone or any other # time zone with the same offset. my $error; TRY: { local $@; eval { my $dt1 = DateTime->now(time_zone => 'local'); my $dt2 = $dt1->clone; $dt2->set_time_zone('Antarctica/Vostok'); die "local is equivalent to Antarctica/Vostok" if($dt1->iso8601 eq $dt2->iso8601); }; $error = $@; } if($error) { SKIP: { skip("timestamp with time zone time change - $db_type", 2) } } else { isnt($o->date_created_tz->iso8601, $o->timestamp_tz2->iso8601, "timestamp with time zone time change - $db_type"); $o->save; $o->load; my $dt = $o->timestamp_tz2->clone; $dt->set_time_zone($o->date_created_tz->time_zone); is($o->date_created_tz->iso8601, $dt->iso8601, "timestamp with time zone time change 2 - $db_type"); } $o->name('C' x 50); is($o->name, 'C' x 32, "varchar truncation - $db_type"); $o->name('John'); $o->code('A'); is($o->code, 'A ', "character padding - $db_type"); $o->code('C' x 50); is($o->code, 'C' x 6, "character truncation - $db_type"); my $ouk; ok($ouk = MyPgObject->new(k1 => 1, k2 => undef, k3 => 3)->load, "load() uk 1 - $db_type"); ok(!$ouk->not_found, "not_found() uk 1 - $db_type"); is($ouk->id, 1, "load() uk 2 - $db_type"); is($ouk->name, 'John', "load() uk 3 - $db_type"); ok($ouk->save, "save() uk 1 - $db_type"); my $o2 = MyPgObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyPgObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 7, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); $o2->flag2(undef); $o2->save; is($o2->flag2, undef, "boolean null - $db_type"); $o2->set_status('foo'); is($o2->get_status, 'foo', "get_status() - $db_type"); $o2->set_status('active'); eval { $o2->set_status }; ok($@, "set_status() - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); my $clone = $o2->clone; ok($o2->start eq $clone->start, "clone() 1 - $db_type"); $clone->start->set(year => '1960'); ok($o2->start ne $clone->start, "clone() 2 - $db_type"); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); ok(!has_modified_columns($o2), "no modified columns after load() - $db_type"); $o2->name('John 2'); $o2->save(changes_only => 1); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $bo = MyPgObject->new(id => $o->id); $bo->load; $bo->flag(0); $bo->save; $bo = MyPgObject->new(id => $o->id); $bo->load; ok(!$bo->flag, "boolean check - $db_type"); $bo->flag(0); $bo->save; my $o3 = MyPgObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyPgObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->load, "load() 4 - $db_type"); SKIP: { if($PG_HAS_CHKPASS) { $o->{'password_encrypted'} = ':8R1Kf2nOS0bRE'; ok($o->password_is('xyzzy'), "chkpass() 1 - $db_type"); is($o->password, 'xyzzy', "chkpass() 2 - $db_type"); $o->password('foobar'); ok($o->password_is('foobar'), "chkpass() 3 - $db_type"); is($o->password, 'foobar', "chkpass() 4 - $db_type"); $o->code('C1'); #local $Rose::DB::Object::Debug = 1; ok($o->save, "save() 3 - $db_type"); $o = MyPgObject->new(id => $o->id)->load; $o->code('C2'); $o->save; $o = MyPgObject->new(id => $o->id)->load; ok($o->password_is('foobar'), "chkpass() 6 - $db_type"); } else { skip("chkpass tests", 6); } } my $o5 = MyPgObject->new(id => $o->id); ok($o5->load, "load() 5 - $db_type"); SKIP: { if($PG_HAS_CHKPASS) { ok($o5->password_is('foobar'), "chkpass() 7 - $db_type"); is($o5->password, 'foobar', "chkpass() 8 - $db_type"); } else { skip("chkpass tests", 2); } } $o5->nums([ 4, 5, 6 ]); ok($o5->save, "save() 4 - $db_type"); ok($o->load, "load() 6 - $db_type"); is($o5->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o5->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o5->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o5->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); ok($o->delete, "delete() - $db_type"); $o = MyPgObject->new(name => 'John', id => 9); $o->save_col(22); ok($o->save, "save() 4 - $db_type"); $o->save_col(50); ok($o->save, "save() 5 - $db_type"); $ouk = MyPgObject->new(save_col => 50); ok($ouk->load, "load() aliased unique key - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, "alias_column() nonesuch - $db_type"); # This is okay now #eval { $o->meta->alias_column(id => 'foo') }; #ok($@, "alias_column() primary key - $db_type"); $o = MyPgObject->new(id => 777); $o->meta->error_mode('fatal'); $o->dbh->{'PrintError'} = 0; eval { $o->load }; ok($@ && $o->not_found, "load() not found fatal - $db_type"); $o->id('abc'); eval { $o->load }; ok($@ && !$o->not_found, "load() fatal - $db_type"); eval { $o->save }; ok($@, "save() fatal - $db_type"); $o = MyPgObject->new(id => 9999); # no such id $o->meta->error_mode('fatal'); eval { $o->load() }; ok($@, "load() non-speculative implicit - $db_type"); ok(!$o->load(speculative => 1), "load() speculative explicit 1 - $db_type"); eval { $o->load(speculative => 0) }; ok($@, "load() non-speculative explicit 2 - $db_type"); $o->meta->default_load_speculative(1); ok(!$o->load(), "load() speculative implicit - $db_type"); ok(!$o->load(speculative => 1), "load() speculative explicit 2 - $db_type"); eval { $o->load(speculative => 0) }; ok($@, "load() non-speculative explicit 2 - $db_type"); # Reset for next trip through loop $o->meta->default_load_speculative(0); $o->meta->error_mode('return'); $o = MyPgObject->new(name => 'John', k1 => 1, k2 => undef, k3 => 3)->save; is($o->dur->months, 2, "interval months 1 - $db_type"); is($o->dur->days, 5, "interval days 1 - $db_type"); is($o->dur->seconds, 3, "interval seconds 1 - $db_type"); $o->dur(DateTime::Duration->new(years => 7, nanoseconds => 3000)); is($o->dur->in_units('years'), 7, "interval in_units years 1 - $db_type"); is($o->dur->in_units('months'), 84, "interval in_units months 1 - $db_type"); is($o->dur->nanoseconds, 3000, "interval nanoseconds 1 - $db_type"); is($o->dur->days, 0, "interval days 2 - $db_type"); is($o->dur->minutes, 0, "interval minutes 2 - $db_type"); is($o->dur->seconds, 0, "interval seconds 2 - $db_type"); $o->save; # Select for update tests $o = MyPgObject->new(id => $o->id); $o->db->begin_work; $o->load(for_update => 1); # Silence errors in eval blocks below Rose::DB->modify_db(type => $db_type)->print_error(0); my $lo; eval { $lo = MyPgObject->new(id => $o->id); $lo->meta->error_mode('fatal'); $lo->load(lock => { for_update => 1, nowait => 1 }); }; is(DBI->err, 7, "select for update wait 1 error 7 - $db_type"); ok($@, "select for update no wait - $db_type"); $o->db->commit; Rose::DB->modify_db(type => $db_type)->print_error(1); $lo = MyPgObject->new(id => $o->id); $lo->load(lock => { type => 'shared' }); $o = MyPgObject->new(id => $o->id)->load; is($o->dur->in_units('years'), 7, "interval in_units years 2 - $db_type"); is($o->dur->in_units('months'), 84, "interval in_units months 2 - $db_type"); is($o->dur->nanoseconds, 3000, "interval nanoseconds 2 - $db_type"); is($o->dur->days, 0, "interval days 3 - $db_type"); is($o->dur->minutes, 0, "interval minutes 3 - $db_type"); is($o->dur->seconds, 0, "interval seconds 3 - $db_type"); is($o->epoch(format => '%Y-%m-%d %H:%M:%S'), '1999-11-30 21:30:00', "epoch 1 - $db_type"); $o->hiepoch('943997400.123456'); is($o->hiepoch(format => '%Y-%m-%d %H:%M:%S.%6N'), '1999-11-30 21:30:00.123456', "epoch hires 1 - $db_type"); $o->epoch('5/6/1980 12:34:56'); $o->save; $o = MyPgObject->new(id => $o->id)->load; is($o->epoch(format => '%Y-%m-%d %H:%M:%S'), '1980-05-06 12:34:56', "epoch 2 - $db_type"); is($o->hiepoch(format => '%Y-%m-%d %H:%M:%S.%6N'), '1999-11-30 21:30:00.123456', "epoch hires 2 - $db_type"); is($o->bint1, '9223372036854775800', "bigint 1 - $db_type"); is($o->bint2, '-9223372036854775800', "bigint 2 - $db_type"); is($o->bint3, '9223372036854775000', "bigint 3 - $db_type"); is($o->bint4, undef, "bigint null 1 - $db_type"); $o->bint4(555); $o->bint1($o->bint1 + 1); $o->save; $o = MyPgObject->new(id => $o->id)->load; is($o->bint1, '9223372036854775801', "bigint 4 - $db_type"); is($o->bint4, 555, "bigint null 2 - $db_type"); $o->bint4(undef); $o->bint3(5); eval { $o->bint3(7) }; ok($@, "bigint 5 - $db_type"); is($o->tee_time5->as_string, '12:34:56.12345', "time(5) - $db_type"); $o->tee_time0('1pm'); $o->tee_time('allballs'); $o->tee_time9('now'); $o->save; $o = MyPgObject->new(id => $o->id)->load; is($o->tee_time->as_string, '00:00:00', "time allballs - $db_type"); ok($o->tee_time9->as_string =~ /^\d\d:\d\d:\d\d\.\d{1,6}$/, "time now - $db_type"); is($o->bint4, undef, "bigint null 3 - $db_type"); $o->tee_time(Time::Clock->new->parse('6:30 PM')); $o->save; $o = MyPgObject->new(id => $o->id)->load; is($o->tee_time->as_string, '18:30:00', "time 6:30 PM - $db_type"); } # # MySQL # SKIP: foreach my $db_type ('mysql') { skip("MySQL tests", 121) unless($HAVE_MYSQL); Rose::DB->default_type($db_type); my $o = MyMySQLObject->new(name => 'John', k1 => 1, k2 => undef, k3 => 3); # Checking to see that Perl code generation methods don't die (See: 0.767 changes) $o->meta->column('name')->check_in([ qw(a b c) ]); $o->meta->perl_class_definition; $o->meta->column('name')->check_in(undef); ok(ref $o && $o->isa('MyMySQLObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(22); $o->bitz3('11'); if(rand >= 0.5) { ok($o->save, "save() 1 - $db_type"); } else { ok($o->insert, "insert() 1 - $db_type"); } # Select for update tests if($INNODB && $ENV{'RDBO_SLOW_TESTS'}) { $o = MyMySQLObject->new(id => $o->id); $o->db->begin_work; $o->load(for_update => 1); # Silence errors in eval blocks below Rose::DB->modify_db(type => $db_type)->print_error(0); my $lo; eval { $lo = MyMySQLObject->new(id => $o->id); $lo->meta->error_mode('fatal'); $lo->load(lock => { for_update => 1 }); }; is(DBI->err, 1205, "select for update wait 1 error 1205 - $db_type"); ok($@, "select for update - $db_type"); $o->db->commit; } else { if($INNODB) { SKIP: { skip("Select for update tests: RDBO_SLOW_TESTS not set - $db_type", 2) } } else { SKIP: { skip("Select for update tests: no InnoDB - $db_type", 2) } } } $o = MyMySQLObject->new(id => $o->id); $o->load(lock => { type => 'shared' }); ok($o->load, "load() 1 - $db_type"); is(ref $o->dt_default, 'DateTime', "now() default - $db_type"); is($o->zepoch->ymd, '1970-01-01', "zero epoch default - $db_type"); is_deeply([ sort $o->items ], [ qw(a c) ], "set default - $db_type"); my $os = MyMySQLObject->new(id => $o->id)->load; $os->items; CATCH_STDERR: { local *STDERR; my $stderr; open(STDERR, '>', \$stderr) or die "Could not redirect STDERR - $!"; local $Rose::DB::Object::Debug = 1; $os->save(changes_only => 1); is($stderr, undef, "save changes only for set column - $db_type"); } my $ox = MyMySQLObject->new(id => $o->id)->load; is($ox->bitz2->to_Bin(), '00', "spot check bitfield 1 - $db_type"); is($ox->bitz3->to_Bin(), '0011', "spot check bitfield 2 - $db_type"); eval { $o->name('C' x 50) }; ok($@, "varchar overflow fatal - $db_type"); $o->name('John'); $o->code('A'); is($o->code, 'A ', "character padding - $db_type"); eval { $o->code('C' x 50) }; ok($@, "code overflow fatal - $db_type"); $o->code('C' x 6); is($o->enums, 'foo', "enum 1 - $db_type"); eval { $o->enums('blee') }; ok($@, "enum 2 - $db_type"); $o->enums('bar'); my $ouk; ok($ouk = MyMySQLObject->new(k1 => 1, k2 => undef, k3 => 3)->load, "load() uk 1 - $db_type"); ok(!$ouk->not_found, "not_found() uk 1 - $db_type"); is($ouk->id, 1, "load() uk 2 - $db_type"); is($ouk->name, 'John', "load() uk 3 - $db_type"); ok($ouk->save, "save() uk 1 - $db_type"); my $o2 = MyMySQLObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyMySQLObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); is($o2->bitz2->to_Bin, '00', "bitz2() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 22, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); $o2->set_status('foo'); is($o2->get_status, 'foo', 'get_status()'); $o2->set_status('active'); eval { $o2->set_status }; ok($@, 'set_status()'); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); is($o2->bitz2->to_Bin, '00', "load() verify 10 (bitfield value) - $db_type"); is($o2->bitz3->to_Bin, '0011', "load() verify 11 (bitfield value) - $db_type"); my $clone = $o2->clone; ok($o2->start eq $clone->start, "clone() 1 - $db_type"); $clone->start->set(year => '1960'); ok($o2->start ne $clone->start, "clone() 2 - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyMySQLObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyMySQLObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); eval { $o->items('z') }; ok($@ =~ /Invalid value/, "set invalid value - $db_type"); $o->items('a', 'b'); $o->nums([ 4, 5, 6 ]); ok($o->save, "save() 3 - $db_type"); ok($o->load, "load() 4 - $db_type"); is_deeply([ sort $o->items ], [ qw(a b) ], "set default - $db_type"); is($o->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); ok($o->delete, "delete() - $db_type"); $o = MyMySQLObject->new(name => 'John', id => 9); $o->save_col(22); ok($o->save, "save() 4 - $db_type"); $o->save_col(50); ok($o->save, "save() 5 - $db_type"); $ouk = MyMySQLObject->new(save_col => 50); ok($ouk->load, "load() aliased unique key - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, "alias_column() nonesuch - $db_type"); # This is okay now #eval { $o->meta->alias_column(id => 'foo') }; #ok($@, "alias_column() primary key - $db_type"); $o = MyMySQLObject->new(id => 777); $o->meta->error_mode('fatal'); $o->dbh->{'PrintError'} = 0; eval { $o->load }; ok($@ && $o->not_found, "load() not found fatal - $db_type"); my $old_table = $o->meta->table; $o->meta->table('nonesuch'); eval { $o->load }; ok($@ && !$o->not_found, "load() fatal - $db_type"); eval { $o->save }; ok($@, "save() fatal - $db_type"); $o->meta->table($old_table); $o->meta->error_mode('return'); $o = MyMPKMySQLObject->new(name => 'John'); ok($o->save, "save() 1 multi-value primary key with generated values - $db_type"); is($o->k1, 1, "save() verify 1 multi-value primary key with generated values - $db_type"); is($o->k2, 2, "save() verify 2 multi-value primary key with generated values - $db_type"); $o = MyMPKMySQLObject->new(name => 'Alex'); ok($o->save, "save() 2 multi-value primary key with generated values - $db_type"); is($o->k1, 3, "save() verify 3 multi-value primary key with generated values - $db_type"); is($o->k2, 4, "save() verify 4 multi-value primary key with generated values - $db_type"); is($ox->bitz3->to_Bin(), '0011', "spot check bitfield 3 - $db_type"); $ox->bitz3->Bit_On(3); is($ox->bitz3->to_Bin(), '1011', "spot check bitfield 4 - $db_type"); $ox->save(insert => 1); $ox = MyMySQLObject->new(id => $ox->id)->load; is($ox->bitz3->to_Bin(), '1011', "spot check bitfield 5 - $db_type"); $ox->bitz3->Bit_On(2); $ox->save; $ox = MyMySQLObject->new(id => $ox->id)->load; is($ox->bitz3->to_Bin(), '1111', "spot check bitfield 6 - $db_type"); $o = MyMySQLObject->new(id => 9999); # no such id $o->meta->error_mode('fatal'); eval { $o->load() }; ok($@, "load() non-speculative implicit - $db_type"); ok(!$o->load(speculative => 1), "load() speculative explicit 1 - $db_type"); eval { $o->load(speculative => 0) }; ok($@, "load() non-speculative explicit 2 - $db_type"); $o->meta->default_load_speculative(1); ok(!$o->load(), "load() speculative implicit - $db_type"); ok(!$o->load(speculative => 1), "load() speculative explicit 2 - $db_type"); eval { $o->load(speculative => 0) }; ok($@, "load() non-speculative explicit 2 - $db_type"); $o->meta->default_load_speculative(0); $o = MyMySQLObject->new(id => 1)->load; is($o->dur->months, 2, "interval months 1 - $db_type"); is($o->dur->days, 5, "interval days 1 - $db_type"); is($o->dur->seconds, 3, "interval seconds 1 - $db_type"); $o->dur(DateTime::Duration->new(years => 7, nanoseconds => 3000)); is($o->dur->in_units('years'), 7, "interval in_units years 1 - $db_type"); is($o->dur->in_units('months'), 84, "interval in_units months 1 - $db_type"); is($o->dur->nanoseconds, 3000, "interval nanoseconds 1 - $db_type"); is($o->dur->days, 0, "interval days 2 - $db_type"); is($o->dur->minutes, 0, "interval minutes 2 - $db_type"); is($o->dur->seconds, 0, "interval seconds 2 - $db_type"); $o->save; $o = MyMySQLObject->new(id => $o->id)->load; is($o->dur->in_units('years'), 7, "interval in_units years 2 - $db_type"); is($o->dur->in_units('months'), 84, "interval in_units months 2 - $db_type"); is($o->dur->nanoseconds, 3000, "interval nanoseconds 2 - $db_type"); is($o->dur->days, 0, "interval days 3 - $db_type"); is($o->dur->minutes, 0, "interval minutes 3 - $db_type"); is($o->dur->seconds, 0, "interval seconds 3 - $db_type"); is($o->meta->column('dur')->scale, 6, "interval scale - $db_type"); is($o->epoch(format => '%Y-%m-%d %H:%M:%S'), '1999-11-30 21:30:00', "epoch 1 - $db_type"); $o->hiepoch('943997400.123456'); is($o->hiepoch(format => '%Y-%m-%d %H:%M:%S.%6N'), '1999-11-30 21:30:00.123456', "epoch hires 1 - $db_type"); $o->epoch('5/6/1980 12:34:56'); $o->save; $o = MyMySQLObject->new(id => $o->id)->load; is($o->epoch(format => '%Y-%m-%d %H:%M:%S'), '1980-05-06 12:34:56', "epoch 2 - $db_type"); is($o->hiepoch(format => '%Y-%m-%d %H:%M:%S.%6N'), '1999-11-30 21:30:00.123456', "epoch hires 2 - $db_type"); is($o->tee_time5->as_string, '12:34:56.12345', "time(5) - $db_type"); $o->tee_time0('1pm'); eval { $o->tee_time('allballs') }; ok($@, "allballs - $db_type"); $o->tee_time('0:00'); $o->tee_time9('now'); $o->save; $o = MyMySQLObject->new(id => $o->id)->load; is($o->tee_time->as_string, '00:00:00', "time allballs - $db_type"); if($Have_HiRes_Time) { ok($o->tee_time9->as_string =~ /^\d\d:\d\d:\d\d\.\d+$/, "time now - $db_type"); } else { ok($o->tee_time9->as_string =~ /^\d\d:\d\d:\d\d$/, "time now - $db_type"); } $o->tee_time(Time::Clock->new->parse('6:30 PM')); $o->save; $o = MyMySQLObject->new(id => $o->id)->load; is($o->tee_time->as_string, '18:30:00', "time 6:30 PM - $db_type"); MyMySQLObject->meta->column('save')->default('x'); MyMySQLObject->meta->make_column_methods(replace_existing => 1); $o->meta->default_load_speculative(0); $o = MyMySQLObject->new(k1 => 1, k3 => 3); ok(!$o->load(speculative => 1), "load default key - $db_type"); eval { $o->load(use_key => 'id') }; ok($@, "use_key no such key - $db_type"); $o->load(use_key => 'k1_k2_k3'); is($o->k1, 1, "load specific key 1 - $db_type"); is($o->k3, 3, "load specific key 2 - $db_type"); is($o->name, 'John', "load specific key 3 - $db_type"); } # # Informix # SKIP: foreach my $db_type ('informix') { skip("Informix tests", 73) unless($HAVE_INFORMIX); Rose::DB->default_type($db_type); my $o = MyInformixObject->new(name => 'John', id => 1, k1 => 1, k2 => undef, k3 => 3); ok(ref $o && $o->isa('MyInformixObject'), "new() 1 - $db_type"); $o->meta->allow_inline_column_values(1); $o->flag2('true'); $o->date_created('current year to fraction(5)'); $o->last_modified($o->date_created); $o->save_col(22); if(rand >= 0.5) { ok($o->save, "save() 1 - $db_type"); } else { ok($o->insert, "insert() 1 - $db_type"); } ok($o->load, "load() 1 - $db_type"); $o->name('C' x 50); is($o->name, 'C' x 32, "varchar truncation - $db_type"); $o->name('John'); $o->code('A'); is($o->code, 'A ', "character padding - $db_type"); $o->code('C' x 50); is($o->code, 'C' x 6, "character truncation - $db_type"); my $ouk; ok($ouk = MyInformixObject->new(k1 => 1, k2 => undef, k3 => 3)->load, "load() uk 1 - $db_type"); ok(!$ouk->not_found, "not_found() uk 1 - $db_type"); is($ouk->id, 1, "load() uk 2 - $db_type"); is($ouk->name, 'John', "load() uk 3 - $db_type"); ok($ouk->save, "save() uk 1 - $db_type"); my $o2 = MyInformixObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyInformixObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 22, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); $o2->set_status('foo'); is($o2->get_status, 'foo', 'get_status()'); $o2->set_status('active'); eval { $o2->set_status }; ok($@, 'set_status()'); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); my $clone = $o2->clone; ok($o2->start eq $clone->start, "clone() 1 - $db_type"); $clone->start->set(year => '1960'); ok($o2->start ne $clone->start, "clone() 2 - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('current year to second'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MyInformixObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyInformixObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); $o->nums([ 4, 5, 6 ]); $o->names([ qw(a b 3.1) ]); ok($o->save, "save() 3 - $db_type"); ok($o->load, "load() 4 - $db_type"); is($o->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o->nums->[2], 6, "load() verify 12 (array value) - $db_type"); $o->nums(7, 8, 9); my @a = $o->nums; is($a[0], 7, "load() verify 13 (array value) - $db_type"); is($a[1], 8, "load() verify 14 (array value) - $db_type"); is($a[2], 9, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); is($o->names->[0], 'a', "load() verify 10 (set value) - $db_type"); is($o->names->[1], 'b', "load() verify 11 (set value) - $db_type"); is($o->names->[2], '3.1', "load() verify 12 (set value) - $db_type"); $o->names('c', 'd', '4.2'); @a = $o->names; is($a[0], 'c', "load() verify 13 (set value) - $db_type"); is($a[1], 'd', "load() verify 14 (set value) - $db_type"); is($a[2], '4.2', "load() verify 15 (set value) - $db_type"); is(@a, 3, "load() verify 16 (set value) - $db_type"); ok($o->delete, "delete() - $db_type"); $o = MyInformixObject->new(name => 'John', id => 9); $o->flag2('true'); $o->date_created('current year to fraction(5)'); $o->last_modified($o->date_created); $o->save_col(22); ok($o->save, "save() 4 - $db_type"); $o->save_col(50); ok($o->save, "save() 5 - $db_type"); $ouk = MyInformixObject->new(save_col => 50); ok($ouk->load, "load() aliased unique key - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, "alias_column() nonesuch - $db_type"); # This is okay now #eval { $o->meta->alias_column(id => 'foo') }; #ok($@, "alias_column() primary key - $db_type"); $o = MyInformixObject->new(id => 777); $o->meta->error_mode('fatal'); $o->dbh->{'PrintError'} = 0; eval { $o->load }; ok($@ && $o->not_found, "load() not found fatal - $db_type"); $o->id('abc'); eval { $o->load }; ok($@ && !$o->not_found, "load() fatal - $db_type"); eval { $o->save }; ok($@, "save() fatal - $db_type"); #$o->meta->error_mode('return'); $o = MyInformixObject->new(id => 9999); # no such id $o->meta->error_mode('fatal'); eval { $o->load() }; ok($@, "load() non-speculative implicit - $db_type"); ok(!$o->load(speculative => 1), "load() speculative explicit 1 - $db_type"); eval { $o->load(speculative => 0) }; ok($@, "load() non-speculative explicit 2 - $db_type"); $o->meta->default_load_speculative(1); ok(!$o->load(), "load() speculative implicit - $db_type"); ok(!$o->load(speculative => 1), "load() speculative explicit 2 - $db_type"); eval { $o->load(speculative => 0) }; ok($@, "load() non-speculative explicit 2 - $db_type"); } # # SQLite # SKIP: foreach my $db_type ('sqlite') { skip("SQLite tests", 75) unless($HAVE_SQLITE); Rose::DB->default_type($db_type); my $o = MySQLiteObject->new(name => 'John', k1 => 1, k2 => undef, k3 => 3); ok(ref $o && $o->isa('MySQLiteObject'), "new() 1 - $db_type"); $o->flag2('true'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(22); if(rand >= 0.5) { ok($o->save, "save() 1 - $db_type"); } else { ok($o->insert, "insert() 1 - $db_type"); } ok($o->load, "load() 1 - $db_type"); $o->name('C' x 50); is($o->name, 'C' x 32, "varchar truncation - $db_type"); $o->name('John'); $o->code('A'); is($o->code, 'A ', "character padding - $db_type"); $o->code('C' x 50); is($o->code, 'C' x 6, "character truncation - $db_type"); my $ouk; ok($ouk = MySQLiteObject->new(k1 => 1, k2 => undef, k3 => 3)->load, "load() uk 1 - $db_type"); ok(!$ouk->not_found, "not_found() uk 1 - $db_type"); is($ouk->id->[0], 1, "load() uk 2 - $db_type"); is($ouk->name, 'John', "load() uk 3 - $db_type"); ok($ouk->save, "save() uk 1 - $db_type"); my $o2 = MySQLiteObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MySQLiteObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 22, "load() verify 7 (aliased column) - $db_type"); is($o2->start->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); $o2->set_status('foo'); is($o2->get_status, 'foo', 'get_status()'); $o2->set_status('active'); eval { $o2->set_status }; ok($@, 'set_status()'); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); my $clone = $o2->clone; ok($o2->start eq $clone->start, "clone() 1 - $db_type"); $clone->start->set(year => '1960'); ok($o2->start ne $clone->start, "clone() 2 - $db_type"); $o2->name('John 2'); $o2->start('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $o3 = MySQLiteObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MySQLiteObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); $o->nums([ 4, 5, 6 ]); ok($o->save, "save() 3 - $db_type"); ok($o->load, "load() 4 - $db_type"); is($o->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); ok($o->delete, "delete() - $db_type"); $o = MySQLiteObject->new(name => 'John', id => 9); $o->save_col(22); ok($o->save, "save() 4 - $db_type"); $o->save_col(50); ok($o->save, "save() 5 - $db_type"); $ouk = MySQLiteObject->new(save_col => 50); ok($ouk->load, "load() aliased unique key - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, "alias_column() nonesuch - $db_type"); # This is okay now #eval { $o->meta->alias_column(id => 'foo') }; #ok($@, "alias_column() primary key - $db_type"); $o = MySQLiteObject->new(id => 777); $o->meta->error_mode('fatal'); $o->dbh->{'PrintError'} = 0; eval { $o->load }; ok($@ && $o->not_found, "load() not found fatal - $db_type"); my $old_table = $o->meta->table; $o->meta->table('nonesuch'); eval { $o->load }; ok($@ && !$o->not_found, "load() fatal - $db_type"); eval { $o->save }; ok($@, "save() fatal - $db_type"); $o->meta->table($old_table); $o->meta->error_mode('return'); $o = MyMPKSQLiteObject->new(name => 'John'); ok($o->save, "save() 1 multi-value primary key with generated values - $db_type"); is($o->k1, 1, "save() verify 1 multi-value primary key with generated values - $db_type"); is($o->k2, 2, "save() verify 2 multi-value primary key with generated values - $db_type"); $o = MyMPKSQLiteObject->new(name => 'Alex'); ok($o->save, "save() 2 multi-value primary key with generated values - $db_type"); is($o->k1, 3, "save() verify 3 multi-value primary key with generated values - $db_type"); is($o->k2, 4, "save() verify 4 multi-value primary key with generated values - $db_type"); $o = MySQLiteObject->new(id => 9999); # no such id $o->meta->error_mode('fatal'); eval { $o->load() }; ok($@, "load() non-speculative implicit - $db_type"); ok(!$o->load(speculative => 1), "load() speculative explicit 1 - $db_type"); eval { $o->load(speculative => 0) }; ok($@, "load() non-speculative explicit 2 - $db_type"); $o->meta->default_load_speculative(1); ok(!$o->load(), "load() speculative implicit - $db_type"); ok(!$o->load(speculative => 1), "load() speculative explicit 2 - $db_type"); eval { $o->load(speculative => 0) }; ok($@, "load() non-speculative explicit 2 - $db_type"); # # Test SQLite BLOB support # my $blob = "abc\0def"; $o = MySQLiteObject->new(id => 888, name => 'Blob', data => $blob); $o->save; $o = MySQLiteObject->new(id => $o->id)->load; is($o->data, $blob, "blob check - $db_type"); } SKIP: foreach my $db_type (qw(oracle)) { skip("Oracle tests", 85) unless($HAVE_ORACLE); Rose::DB->default_type($db_type); TEST_HACK: { no warnings; *MyOracleObject::init_db = sub { Rose::DB->new($db_type) }; } my $o = MyOracleObject->new(name => 'John', k1 => 1, k2 => undef, k3 => 3); ok(ref $o && $o->isa('MyOracleObject'), "new() 1 - $db_type"); $o->flag2('TRUE'); $o->date_created('now'); $o->date_created_tz('now'); $o->timestamp_tz2('now'); $o->last_modified($o->date_created); $o->save_col(7); if(rand >= 0.5) { ok($o->save, "save() 1 - $db_type"); } else { ok($o->insert, "insert() 1 - $db_type"); } is($o->meta->primary_key->sequence_names->[0], 'ROSE_DB_OBJECT_TEST_ID_SEQ', "pk sequence name - $db_type"); ok(is_in_db($o), "is_in_db - $db_type"); is($o->id, 1, "auto-generated primary key - $db_type"); if(oracle_is_broken()) { SKIP: { skip("tests that trigger the dreaded ORA-00600 kpofdr-long error", 4) } } else { ok($o->load, "load() 1 - $db_type"); is($o->date_created->time_zone->name, 'floating', "timestamp without time zone - $db_type"); isnt($o->date_created_tz->time_zone->name, 'floating', "timestamp with time zone - $db_type"); is($o->timestamp_tz2->time_zone->name, 'Antarctica/Vostok', "timestamp with time zone override - $db_type"); # Make sure we're not in the Antarctica/Vostok time zone or any other # time zone with the same offset. my $error; TRY: { local $@; eval { my $dt1 = DateTime->now(time_zone => 'local'); my $dt2 = $dt1->clone; $dt2->set_time_zone('Antarctica/Vostok'); die "local is equivalent to Antarctica/Vostok" if($dt1->iso8601 eq $dt2->iso8601); }; $error = $@; } if($error) { SKIP: { skip("timestamp with time zone time change - $db_type", 2) } } else { isnt($o->date_created_tz->iso8601, $o->timestamp_tz2->iso8601, "timestamp with time zone time change - $db_type"); $o->save; $o->load; my $dt = $o->timestamp_tz2->clone; $dt->set_time_zone($o->date_created_tz->time_zone); is($o->date_created_tz->iso8601, $dt->iso8601, "timestamp with time zone time change 2 - $db_type"); } $o->name('C' x 50); is($o->name, 'C' x 32, "varchar truncation - $db_type"); $o->name('John'); $o->code('A'); is($o->code, 'A ', "character padding - $db_type"); $o->code('C' x 50); is($o->code, 'C' x 6, "character truncation - $db_type"); } my $ouk; ok($ouk = MyOracleObject->new(k1 => 1, k2 => undef, k3 => 3)->load, "load() uk 1 - $db_type"); ok(!$ouk->not_found, "not_found() uk 1 - $db_type"); is($ouk->id, 1, "load() uk 2 - $db_type"); is($ouk->name, 'John', "load() uk 3 - $db_type"); ok($ouk->save, "save() uk 1 - $db_type"); my $o2 = MyOracleObject->new(id => $o->id); ok(ref $o2 && $o2->isa('MyOracleObject'), "new() 2 - $db_type"); is($o2->bits->to_Bin, '00101', "bits() (bitfield default value) - $db_type"); if(oracle_is_broken()) { SKIP: { skip("tests that trigger the dreaded ORA-00600 kpofdr-long error", 22) } } else { ok($o2->load, "load() 2 - $db_type"); ok(!$o2->not_found, "not_found() 1 - $db_type"); is($o2->name, $o->name, "load() verify 1 - $db_type"); is($o2->date_created, $o->date_created, "load() verify 2 - $db_type"); is($o2->last_modified, $o->last_modified, "load() verify 3 - $db_type"); is($o2->status, 'active', "load() verify 4 (default value) - $db_type"); is($o2->flag, 1, "load() verify 5 (default boolean value) - $db_type"); is($o2->flag2, 1, "load() verify 6 (boolean value) - $db_type"); is($o2->save_col, 7, "load() verify 7 (aliased column) - $db_type"); is($o2->start_date->ymd, '1980-12-24', "load() verify 8 (date value) - $db_type"); $o2->set_status('foo'); is($o2->get_status, 'foo', "get_status() - $db_type"); $o2->set_status('active'); eval { $o2->set_status }; ok($@, "set_status() - $db_type"); is($o2->bits->to_Bin, '00101', "load() verify 9 (bitfield value) - $db_type"); my $clone = $o2->clone; ok($o2->start_date eq $clone->start_date, "clone() 1 - $db_type"); $clone->start_date->set(year => '1960'); ok($o2->start_date ne $clone->start_date, "clone() 2 - $db_type"); $o2->start_date('5/24/2001'); sleep(1); # keep the last modified dates from being the same $o2->last_modified('now'); ok($o2->save, "save() 2 - $db_type"); ok($o2->load, "load() 3 - $db_type"); ok(!has_modified_columns($o2), "no modified columns after load() - $db_type"); $o2->name('John 2'); $o2->save(changes_only => 1); is($o2->date_created, $o->date_created, "save() verify 1 - $db_type"); ok($o2->last_modified ne $o->last_modified, "save() verify 2 - $db_type"); is($o2->start_date->ymd, '2001-05-24', "save() verify 3 (date value) - $db_type"); my $bo = MyOracleObject->new(id => $o->id); $bo->load; $bo->flag(0); $bo->save; $bo = MyOracleObject->new(id => $o->id); $bo->load; ok(!$bo->flag, "boolean check - $db_type"); $bo->flag(0); $bo->save; } my $o3 = MyOracleObject->new(); my $db = $o3->db or die $o3->error; ok(ref $db && $db->isa('Rose::DB'), "db() - $db_type"); is($db->dbh, $o3->dbh, "dbh() - $db_type"); my $o4 = MyOracleObject->new(id => 999); ok(!$o4->load(speculative => 1), "load() nonexistent - $db_type"); ok($o4->not_found, "not_found() 2 - $db_type"); ok($o->load, "load() 4 - $db_type"); my $o5 = MyOracleObject->new(id => $o->id); ok($o5->load, "load() 5 - $db_type"); $o5->nums([ 4, 5, 6 ]); ok($o5->save, "save() 4 - $db_type"); ok($o->load, "load() 6 - $db_type"); is($o5->nums->[0], 4, "load() verify 10 (array value) - $db_type"); is($o5->nums->[1], 5, "load() verify 11 (array value) - $db_type"); is($o5->nums->[2], 6, "load() verify 12 (array value) - $db_type"); my @a = $o5->nums; is($a[0], 4, "load() verify 13 (array value) - $db_type"); is($a[1], 5, "load() verify 14 (array value) - $db_type"); is($a[2], 6, "load() verify 15 (array value) - $db_type"); is(@a, 3, "load() verify 16 (array value) - $db_type"); ok($o->delete, "delete() - $db_type"); $o = MyOracleObject->new(name => 'John', id => 9); $o->save_col(22); ok($o->save, "save() 4 - $db_type"); $o->save_col(50); ok($o->save, "save() 5 - $db_type"); $ouk = MyOracleObject->new(save_col => 50); ok($ouk->load, "load() aliased unique key - $db_type"); eval { $o->meta->alias_column(nonesuch => 'foo') }; ok($@, "alias_column() nonesuch - $db_type"); # This is okay now #eval { $o->meta->alias_column(id => 'foo') }; #ok($@, "alias_column() primary key - $db_type"); $o = MyOracleObject->new(id => 777); $o->meta->error_mode('fatal'); $o->dbh->{'PrintError'} = 0; eval { $o->load }; ok($@ && $o->not_found, "load() not found fatal - $db_type"); $o->id('abc'); eval { $o->load }; ok($@ && !$o->not_found, "load() fatal - $db_type"); eval { $o->save }; ok($@, "save() fatal - $db_type"); $o = MyOracleObject->new(id => 9999); # no such id $o->meta->error_mode('fatal'); eval { $o->load() }; ok($@, "load() non-speculative implicit - $db_type"); ok(!$o->load(speculative => 1), "load() speculative explicit 1 - $db_type"); eval { $o->load(speculative => 0) }; ok($@, "load() non-speculative explicit 2 - $db_type"); $o->meta->default_load_speculative(1); ok(!$o->load(), "load() speculative implicit - $db_type"); ok(!$o->load(speculative => 1), "load() speculative explicit 2 - $db_type"); eval { $o->load(speculative => 0) }; ok($@, "load() non-speculative explicit 2 - $db_type"); $o = MyOracleObject->new(name => 'Sequence Test', k1 => 4, k2 => 5, k3 => 6, key => 123); $o->save; like($o->id, qr/^\d+$/, "save() serial - $db_type"); # Select for update tests $o = MyOracleObject->new(id => $o->id)->load(for_update => 1, lock => { columns => [ qw(k2 k3) ] }); # Silence errors in eval blocks below Rose::DB->modify_db(type => $db_type)->print_error(0); eval { $o = MyOracleObject->new(id => $o->id)->load( lock => { type => 'for update', on => [ qw(k2 k3) ], nowait => 1, }); }; ok($@, "select for update failure - $db_type"); my $lo; eval { $lo = MyOracleObject->new(id => $o->id); $lo->load(lock => { for_update => 1, nowait => 1 }); }; is(DBI->err, 54, "select for update no wait ORA-00054 - $db_type"); ok($@, "select for update no wait - $db_type"); eval { $lo = MyOracleObject->new(id => $o->id); $lo->load(lock => { type => 'for update', wait => 1 }); }; is(DBI->err, 30006, "select for update wait 1 ORA-30006 - $db_type"); ok($@, "select for update wait 1 - $db_type"); $o->save; Rose::DB->modify_db(type => $db_type)->print_error(1); # Reset for next trip through loop (if any) $o->meta->default_load_speculative(0); $o->meta->error_mode('return'); $o = MyOracleObject->new(key => 123); eval { $o->load }; ok(!$@, "reserved-word load() - $db_type"); } BEGIN { # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_PG = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_private.rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_chkpass_test'); $dbh->do('CREATE SCHEMA rose_db_object_private'); } our $PG_HAS_CHKPASS = pg_has_chkpass(); $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, k1 INT, k2 INT, k3 INT, @{[ $PG_HAS_CHKPASS ? 'passwd CHKPASS,' : '' ]} name VARCHAR(32) NOT NULL, code CHAR(6), flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bitz BIT(5) NOT NULL DEFAULT B'00101', decs DECIMAL(10,2), start DATE, save INT, nums INT[], dur INTERVAL(6) DEFAULT '2 months 5 days 3 seconds', epoch INT DEFAULT 943997400, hiepoch DECIMAL(16,6), bint1 BIGINT DEFAULT 9223372036854775800, bint2 BIGINT DEFAULT -9223372036854775800, bint3 BIGINT, bint4 BIGINT, tee_time TIME, tee_time0 TIME(0), tee_time5 TIME(5), tee_time9 TIME(9), last_modified TIMESTAMP, date_created TIMESTAMP, date_created_tz TIMESTAMP WITH TIME ZONE, timestamp_tz2 TIMESTAMP WITH TIME ZONE, UNIQUE(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_private.rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, k1 INT, k2 INT, k3 INT, @{[ $PG_HAS_CHKPASS ? 'passwd CHKPASS,' : '' ]} name VARCHAR(32) NOT NULL, code CHAR(6), flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bitz BIT(5) NOT NULL DEFAULT B'00101', decs DECIMAL(10,2), start DATE, save INT, nums INT[], dur INTERVAL(6) DEFAULT '2 months 5 days 3 seconds', epoch INT DEFAULT 943997400, hiepoch DECIMAL(16,6), bint1 BIGINT DEFAULT 9223372036854775800, bint2 BIGINT DEFAULT -9223372036854775800, bint3 BIGINT, bint4 BIGINT, tee_time TIME, tee_time0 TIME(0), tee_time5 TIME(5), tee_time9 TIME(9), last_modified TIMESTAMP, date_created TIMESTAMP, date_created_tz TIMESTAMP WITH TIME ZONE, timestamp_tz2 TIMESTAMP WITH TIME ZONE, UNIQUE(k1, k2, k3) ) EOF $dbh->disconnect; # Create test subclass package MyPgObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } MyPgObject->meta->table('rose_db_object_test'); MyPgObject->meta->columns ( name => { type => 'varchar', length => 32, overflow => 'truncate' }, code => { type => 'char', length => 6, overflow => 'truncate' }, id => { primary_key => 1, not_null => 1 }, k1 => { type => 'int' }, k2 => { type => 'int', lazy => 1 }, k3 => { type => 'int' }, ($PG_HAS_CHKPASS ? (passwd => { type => 'chkpass', alias => 'password' }) : ()), flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active', add_methods => [ qw(get set) ] }, start => { type => 'date', default => '12/24/1980', lazy => 1 }, save => { type => 'scalar' }, nums => { type => 'array' }, bitz => { type => 'bitfield', bits => 5, default => 101, alias => 'bits' }, decs => { type => 'decimal', precision => 10, scale => 2 }, dur => { type => 'interval', scale => 6, default => '2 months 5 days 3 seconds' }, epoch => { type => 'epoch', default => '11/30/1999 9:30pm' }, hiepoch => { type => 'epoch hires', default => '1144004926.123456' }, bint1 => { type => 'bigint', default => '9223372036854775800' }, bint2 => { type => 'bigint', default => '-9223372036854775800' }, bint3 => { type => 'bigint', with_init => 1, check_in => [ '9223372036854775000', 5 ] }, bint4 => { type => 'bigint' }, tee_time => { type => 'time' }, tee_time0 => { type => 'time', scale => 0 }, tee_time5 => { type => 'time', scale => 5, default => '12:34:56.123456789' }, tee_time9 => { type => 'time', scale => 9 }, #last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, date_created_tz => { type => 'timestamp with time zone' }, timestamp_tz2 => { type => 'timestamp with time zone', time_zone => 'Antarctica/Vostok' }, main::nonpersistent_column_definitions(), ); MyPgObject->meta->add_unique_key('save'); MyPgObject->meta->add_unique_key([ qw(k1 k2 k3) ]); MyPgObject->meta->add_columns( Rose::DB::Object::Metadata::Column::Timestamp->new( name => 'last_modified')); eval { MyPgObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MyPgObject->meta->alias_column(save => 'save_col'); eval { MyPgObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() no override'); MyPgObject->meta->initialize(preserve_existing => 1); Test::More::is(MyPgObject->meta->column('id')->is_primary_key_member, 1, 'is_primary_key_member - pg'); Test::More::is(MyPgObject->meta->column('id')->primary_key_position, 1, 'primary_key_position 1 - pg'); Test::More::ok(!defined MyPgObject->meta->column('k1')->primary_key_position, 'primary_key_position 2 - pg'); MyPgObject->meta->column('k1')->primary_key_position(7); Test::More::ok(!defined MyPgObject->meta->column('k1')->primary_key_position, 'primary_key_position 3 - pg'); sub init_bint3 { '9223372036854775000' } } # # MySQL # my $db_version; eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh() or die Rose::DB->error; $db_version = $db->database_version; }; if(!$@ && $dbh) { our $HAVE_MYSQL = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_test2'); } # MySQL 5.0.3 or later has a completely stupid "native" BIT type my $bit_col1 = ($db_version >= 5_000_003) ? q(bitz BIT(5) NOT NULL DEFAULT B'00101') : q(bitz BIT(5) NOT NULL DEFAULT '00101'); my $bit_col2 = ($db_version >= 5_000_003) ? q(bitz2 BIT(2) NOT NULL DEFAULT B'00') : q(bitz2 BIT(2) NOT NULL DEFAULT '0'); my $set_col = ($db_version >= 5_000_000) ? q(items SET('a','b','c') NOT NULL DEFAULT 'a,c') : q(items VARCHAR(255) NOT NULL DEFAULT 'a,c'); my $engine = ''; if(our $INNODB = mysql_supports_innodb()) { $engine = 'ENGINE=InnoDB'; } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, k1 INT, k2 INT, k3 INT, name VARCHAR(32) NOT NULL, code CHAR(6), flag TINYINT(1) NOT NULL, flag2 TINYINT(1), status VARCHAR(32) DEFAULT 'active', $bit_col1, $bit_col2, $set_col, bitz3 BIT(4), decs FLOAT(10,2), nums VARCHAR(255), start DATE, save INT, enums ENUM('foo', 'bar', 'baz') DEFAULT 'foo', ndate DATE NOT NULL DEFAULT '0000-00-00', dur VARCHAR(255) DEFAULT '2 months 5 days 3 seconds', epoch INT DEFAULT 943997400, hiepoch DECIMAL(16,6), zepoch INT NOT NULL DEFAULT 0, tee_time VARCHAR(32), tee_time0 VARCHAR(32), tee_time5 VARCHAR(32) DEFAULT '12:34:56.123456789', tee_time9 VARCHAR(32), dt_default TIMESTAMP, last_modified TIMESTAMP, date_created TIMESTAMP, UNIQUE(k1, k2, k3) ) $engine EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test2 ( k1 INT NOT NULL, k2 INT NOT NULL, name VARCHAR(32), UNIQUE(k1, k2) ) EOF $dbh->disconnect; # Create test subclass package MyMySQLObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } MyMySQLObject->meta->allow_inline_column_values(1); MyMySQLObject->meta->table('rose_db_object_test'); MyMySQLObject->meta->columns ( name => { type => 'varchar', length => 32 }, code => { type => 'char', length => 6 }, id => { primary_key => 1, not_null => 1 }, k1 => { type => 'int' }, k2 => { type => 'int', lazy => 1 }, k3 => { type => 'int' }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active', methods => [ qw(get_set get set) ] }, start => { type => 'date', default => '12/24/1980', lazy => 1 }, ndate => { type => 'date', not_null => 1, default => '0000-00-00' }, save => { type => 'scalar' }, nums => { type => 'array' }, enums => { type => 'enum', values => [ qw(foo bar baz) ], default => 'foo' }, bitz => { type => 'bitfield', bits => 5, default => 101, alias => 'bits' }, bitz2 => { type => 'bits', bits => 2, default => '0' }, bitz3 => { type => 'bits', bits => 4 }, items => { type => 'set', check_in => [ qw(a b c) ], default => 'a,c' }, decs => { type => 'decimal', precision => 10, scale => 2 }, dur => { type => 'interval', scale => 6, default => '2 months 5 days 3 seconds' }, epoch => { type => 'epoch', default => '11/30/1999 9:30pm' }, hiepoch => { type => 'epoch hires', default => '1144004926.123456' }, zepoch => { type => 'epoch', default => 0, not_null => 1, time_zone => 'UTC' }, tee_time => { type => 'time' }, tee_time0 => { type => 'time', scale => 0 }, tee_time5 => { type => 'time', scale => 5, default => '12:34:56.123456789' }, tee_time9 => { type => 'time', scale => 9 }, dt_default => { type => 'timestamp', default => 'now()' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, main::nonpersistent_column_definitions(), ); eval { MyMySQLObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MyMySQLObject->meta->alias_column(save => 'save_col'); eval { MyMySQLObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() no override'); MyMySQLObject->meta->add_unique_key('save'); MyMySQLObject->meta->add_unique_key([ qw(k1 k2 k3) ]); MyMySQLObject->meta->initialize(preserve_existing => 1); Test::More::is(MyMySQLObject->meta->column('id')->is_primary_key_member, 1, 'is_primary_key_member - mysql'); Test::More::is(MyMySQLObject->meta->column('id')->primary_key_position, 1, 'primary_key_position 1 - mysql'); Test::More::ok(!defined MyMySQLObject->meta->column('k1')->primary_key_position, 'primary_key_position 2 - mysql'); MyMySQLObject->meta->column('k1')->primary_key_position(7); Test::More::ok(!defined MyMySQLObject->meta->column('k1')->primary_key_position, 'primary_key_position 3 - mysql'); package MyMPKMySQLObject; use Rose::DB::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } MyMPKMySQLObject->meta->table('rose_db_object_test2'); MyMPKMySQLObject->meta->columns ( k1 => { type => 'int', not_null => 1 }, k2 => { type => 'int', not_null => 1 }, name => { type => 'varchar', length => 32 }, ); MyMPKMySQLObject->meta->primary_key_columns('k1', 'k2'); my $i = 1; MyMPKMySQLObject->meta->setup ( primary_key_generator => sub { my($meta, $db) = @_; my $k1 = $i++; my $k2 = $i++; return $k1, $k2; }, ); } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_INFORMIX = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, k1 INT, k2 INT, k3 INT, name VARCHAR(32) NOT NULL, code CHAR(6), flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bitz VARCHAR(5) DEFAULT '00101' NOT NULL, decs DECIMAL(10,2), nums VARCHAR(255), start DATE, save INT, names SET(VARCHAR(64) NOT NULL), last_modified DATETIME YEAR TO FRACTION(5), date_created DATETIME YEAR TO FRACTION(5) ) EOF $dbh->disconnect; # Create test subclass package MyInformixObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('informix') } MyInformixObject->meta->allow_inline_column_values(1); MyInformixObject->meta->table('rose_db_object_test'); MyInformixObject->meta->columns ( name => { type => 'varchar', length => 32, overflow => 'truncate' }, code => { type => 'char', length => 6, overflow => 'truncate' }, id => { type => 'serial', primary_key => 1, not_null => 1 }, k1 => { type => 'int' }, k2 => { type => 'int', lazy => 1 }, k3 => { type => 'int' }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active', add_methods => [ qw(get set) ] }, start => { type => 'date', default => '12/24/1980', lazy => 1 }, save => { type => 'scalar' }, nums => { type => 'array' }, bitz => { type => 'bitfield', bits => 5, default => 101, alias => 'bits' }, decs => { type => 'decimal', precision => 10, scale => 2 }, names => { type => 'set' }, last_modified => { type => 'timestamp' }, date_created => { type => 'datetime year to fraction(5)' }, main::nonpersistent_column_definitions(), ); eval { MyInformixObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MyInformixObject->meta->prepare_options({ix_CursorWithHold => 1}); MyInformixObject->meta->alias_column(save => 'save_col'); eval { MyInformixObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() no override'); MyInformixObject->meta->add_unique_key('save'); MyInformixObject->meta->add_unique_key([ qw(k1 k2 k3) ]); MyInformixObject->meta->initialize(preserve_existing => 1); Test::More::is(MyInformixObject->meta->column('id')->is_primary_key_member, 1, 'is_primary_key_member - informix'); Test::More::is(MyInformixObject->meta->column('id')->primary_key_position, 1, 'primary_key_position 1 - informix'); Test::More::ok(!defined MyInformixObject->meta->column('k1')->primary_key_position, 'primary_key_position 2 - informix'); MyInformixObject->meta->column('k1')->primary_key_position(7); Test::More::ok(!defined MyInformixObject->meta->column('k1')->primary_key_position, 'primary_key_position 3 - informix'); } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_SQLITE = 1; # # Method name conflict tests # local $@; eval { package MyNameConflictB; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } __PACKAGE__->meta->setup ( table => 'foob', columns => [ qw(id blee) ], ); package MyNameConflictA; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } __PACKAGE__->meta->setup ( table => 'fooa', columns => [ qw(bar baz) ], foreign_keys => [ new => { class => 'MyNameConflictB', key_columns => { baz => 'id' }, }, ], ); }; like($@, qr/Rose::DB::Object defines a method with the same name/, 'method name conflict'); # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_test2'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INTEGER PRIMARY KEY AUTOINCREMENT, k1 INT, k2 INT, k3 INT, name VARCHAR(32) NOT NULL, code CHAR(6), flag BOOLEAN NOT NULL, flag2 BOOLEAN, status VARCHAR(32) DEFAULT 'active', bitz VARCHAR(5) DEFAULT '00101' NOT NULL, decs DECIMAL(10,2), start DATE, save INT, nums VARCHAR(255), data BLOB, last_modified TIMESTAMP, date_created TIMESTAMP, UNIQUE(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test2 ( k1 INT NOT NULL, k2 INT NOT NULL, name VARCHAR(32), UNIQUE(k1, k2) ) EOF $dbh->disconnect; # Create test subclass package MySQLiteObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MySQLiteObject->meta->table('rose_db_object_test'); MySQLiteObject->meta->columns ( name => { type => 'varchar', length => 32, overflow => 'truncate' }, code => { type => 'char', length => 6, overflow => 'truncate' }, id => { primary_key => 1, not_null => 1 }, k1 => { type => 'int' }, k2 => { type => 'int', lazy => 1 }, k3 => { type => 'int' }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active', add_methods => [ qw(get set) ] }, start => { type => 'date', default => '12/24/1980', lazy => 1 }, save => { type => 'scalar' }, nums => { type => 'array' }, bitz => { type => 'bitfield', bits => 5, default => 101, alias => 'bits' }, decs => { type => 'decimal', precision => 10, scale => 2 }, data => { type => 'blob' }, #last_modified => { type => 'timestamp' }, date_created => { type => 'scalar' }, main::nonpersistent_column_definitions(), ); MySQLiteObject->meta->replace_column(date_created => { type => 'timestamp' }); MySQLiteObject->meta->add_unique_key('save'); MySQLiteObject->meta->add_unique_key([ qw(k1 k2 k3) ]); MySQLiteObject->meta->add_columns( Rose::DB::Object::Metadata::Column::Timestamp->new( name => 'last_modified')); MySQLiteObject->meta->column('id')->add_trigger(inflate => sub { defined $_[1] ? [ $_[1] ] : undef }); MySQLiteObject->meta->column('id')->add_trigger(deflate => sub { ref $_[1] ? (wantarray ? @{$_[1]} : $_[1]->[0]) : $_[1] }); my $pre_inited = 0; MySQLiteObject->meta->pre_init_hook(sub { $pre_inited++ }); eval { MySQLiteObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); Test::More::is($pre_inited, 1, 'meta->pre_init_hook()'); MySQLiteObject->meta->alias_column(save => 'save_col'); eval { MySQLiteObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() no override'); MySQLiteObject->meta->initialize(preserve_existing => 1); Test::More::is(MySQLiteObject->meta->column('id')->is_primary_key_member, 1, 'is_primary_key_member - sqlite'); Test::More::is(MySQLiteObject->meta->column('id')->primary_key_position, 1, 'primary_key_position 1 - sqlite'); Test::More::ok(!defined MySQLiteObject->meta->column('k1')->primary_key_position, 'primary_key_position 2 - sqlite'); MySQLiteObject->meta->column('k1')->primary_key_position(7); Test::More::ok(!defined MySQLiteObject->meta->column('k1')->primary_key_position, 'primary_key_position 3 - sqlite'); package MyMPKSQLiteObject; use Rose::DB::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MyMPKSQLiteObject->meta->table('rose_db_object_test2'); MyMPKSQLiteObject->meta->columns ( k1 => { type => 'int', not_null => 1 }, k2 => { type => 'int', not_null => 1 }, name => { type => 'varchar', length => 32 }, ); MyMPKSQLiteObject->meta->primary_key_columns('k1', 'k2'); MyMPKSQLiteObject->meta->initialize; my $i = 1; MyMPKSQLiteObject->meta->primary_key_generator(sub { my($meta, $db) = @_; my $k1 = $i++; my $k2 = $i++; return $k1, $k2; }); } # # Oracle # eval { $dbh = Rose::DB->new('oracle_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_ORACLE = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP SEQUENCE rose_db_object_test_id_seq'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT NOT NULL PRIMARY KEY, k1 INT, k2 INT, k3 INT, name VARCHAR(32) NOT NULL, code CHAR(6), flag CHAR(1) NOT NULL CHECK(flag IN ('t', 'f')), flag2 CHAR(1) CHECK(flag2 IN ('t', 'f')), status VARCHAR(32) DEFAULT 'active', bitz VARCHAR(5) DEFAULT '00101' NOT NULL, decs NUMBER(10,2), nums VARCHAR(255), start_date DATE, save INT, claim# INT, key INT, last_modified TIMESTAMP, date_created TIMESTAMP, date_created_tz TIMESTAMP WITH TIME ZONE, timestamp_tz2 TIMESTAMP WITH TIME ZONE ) EOF $dbh->do(<<"EOF"); CREATE SEQUENCE rose_db_object_test_id_seq EOF $dbh->do(<<"EOF"); CREATE OR REPLACE TRIGGER rose_db_object_test_insert BEFORE INSERT ON rose_db_object_test FOR EACH ROW BEGIN SELECT NVL(:new.id, rose_db_object_test_id_seq.nextval) INTO :new.id FROM dual; END; EOF $dbh->commit; $dbh->disconnect; # Create test subclass package MyOracleObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('oracle') } MyOracleObject->meta->allow_inline_column_values(1); MyOracleObject->meta->table('rose_db_object_test'); MyOracleObject->meta->columns ( name => { type => 'varchar', length => 32, overflow => 'truncate' }, code => { type => 'char', length => 6, overflow => 'truncate' }, id => { type => 'serial', primary_key => 1, not_null => 1 }, k1 => { type => 'int' }, k2 => { type => 'int', lazy => 1 }, k3 => { type => 'int' }, key => { type => 'int' }, flag => { type => 'boolean', default => 1 }, flag2 => { type => 'boolean' }, status => { default => 'active', add_methods => [ qw(get set) ] }, start_date => { type => 'date', default => '12/24/1980', lazy => 1 }, save => { type => 'scalar' }, 'claim#' => { type => 'int' }, nums => { type => 'array' }, bitz => { type => 'bitfield', bits => 5, default => 101, alias => 'bits' }, decs => { type => 'decimal', precision => 10, scale => 2 }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, date_created_tz => { type => 'timestamp with time zone' }, timestamp_tz2 => { type => 'timestamp with time zone', time_zone => 'Antarctica/Vostok' }, main::nonpersistent_column_definitions(), ); eval { MyOracleObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() reserved method'); MyOracleObject->meta->prepare_options({ix_CursorWithHold => 1}); MyOracleObject->meta->alias_column(save => 'save_col'); eval { MyOracleObject->meta->initialize }; Test::More::ok($@, 'meta->initialize() no override'); MyOracleObject->meta->add_unique_key('save'); MyOracleObject->meta->add_unique_key('key'); MyOracleObject->meta->add_unique_key([ qw(k1 k2 k3) ]); MyOracleObject->meta->initialize(preserve_existing => 1); Test::More::is(MyOracleObject->meta->column('id')->is_primary_key_member, 1, 'is_primary_key_member - oracle'); Test::More::is(MyOracleObject->meta->column('id')->primary_key_position, 1, 'primary_key_position 1 - oracle'); Test::More::ok(!defined MyOracleObject->meta->column('k1')->primary_key_position, 'primary_key_position 2 - oracle'); MyOracleObject->meta->column('k1')->primary_key_position(7); Test::More::ok(!defined MyOracleObject->meta->column('k1')->primary_key_position, 'primary_key_position 3 - oracle'); } } END { # Delete test table if($HAVE_PG) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_private.rose_db_object_test'); $dbh->do('DROP SCHEMA rose_db_object_private CASCADE'); $dbh->disconnect; } if($HAVE_MYSQL) { my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_test2'); $dbh->disconnect; } if($HAVE_INFORMIX) { my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } if($HAVE_SQLITE) { my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_test2'); $dbh->disconnect; } if($HAVE_ORACLE) { my $dbh = Rose::DB->new('oracle_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP SEQUENCE rose_db_object_test_id_seq'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/deep-joins.t000755 000765 000120 00000227245 12102774127 016713 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 1627; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Loader'); use_ok('Rose::DB::Object::Helpers'); } use Data::Dumper; $Data::Dumper::Sortkeys = 1; our %Have; # # Tests # use Rose::DB::Object::Constants qw(STATE_SAVING); #$Rose::DB::Object::Manager::Debug = 1; if(defined $ENV{'RDBO_NESTED_JOINS'} && Rose::DB::Object::Manager->can('default_nested_joins')) { Rose::DB::Object::Manager->default_nested_joins($ENV{'RDBO_NESTED_JOINS'}); } my $Include = '^(?:' . join('|', qw(colors descriptions authors nicknames description_author_map product_color_map prices products vendors regions)) . ')$'; $Include = qr($Include); foreach my $db_type (qw(sqlite mysql pg pg_with_schema informix)) { SKIP: { skip("$db_type tests", 325) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB->default_type($db_type); Rose::DB::Object::Metadata->unregister_all_classes; # Test of the subselect limit code #Rose::DB::Object::Manager->default_limit_with_subselect(1) if($db_type =~ /^pg/); my $db = Rose::DB->new; my $class_prefix = ucfirst($db_type eq 'pg_with_schema' ? 'pgws' : $db_type); my $loader = Rose::DB::Object::Loader->new( db => $db, class_prefix => $class_prefix); my @classes = $loader->make_classes(include_tables => $Include); my $product_class = $class_prefix . '::Product'; my $manager_class = $product_class . '::Manager'; Rose::DB::Object::Helpers->import(-target_class => $product_class, qw(as_tree new_from_tree init_with_tree)); my $p1 = $product_class->new( id => 1, name => 'Kite', vendor => { id => 1, name => 'V1', region => { id => 'DE', name => 'Germany' } }, prices => [ { price => 1.25, region => { id => 'US', name => 'America' } }, { price => 4.25, region => { id => 'DE', name => 'Germany' } }, ], colors => [ { name => 'red', description => { text => 'desc 1', authors => [ { name => 'john', nicknames => [ { nick => 'jack' }, { nick => 'sir' } ], }, { name => 'sue', nicknames => [ { nick => 'sioux' } ], }, ], }, }, { name => 'blue', description => { text => 'desc 2', authors => [ { name => 'john' }, { name => 'jane', nicknames => [ { nick => 'blub' } ], }, ], } } ]); $p1->save; my $p2 = $product_class->new( id => 2, name => 'Sled', vendor => { id => 2, name => 'V2', region_id => 'US', vendor_id => 1 }, prices => [ { price => 9.25 } ], colors => [ { name => 'red' }, { name => 'green', description => { text => 'desc 3', authors => [ { name => 'tim' } ], } } ]); $p2->save; my $p3 = $product_class->new( id => 3, name => 'Barn', vendor => { id => 3, name => 'V3', region => { id => 'UK', name => 'England' }, vendor_id => 2 }, prices => [ { price => 100 } ], colors => [ { name => 'green' }, { name => 'pink', description => { text => 'desc 4', authors => [ { name => 'joe', nicknames => [ { nick => 'joey' } ] } ], } } ]); $p3->save; #local $Rose::DB::Object::Manager::Debug = 1; my $products = $manager_class->get_products( db => $db, require_objects => [ 'vendor.vendor', 'vendor.region' ]); is(scalar @$products, 2, "require vendors 1 - $db_type"); is($products->[0]{'vendor'}{'id'}, 2, "p2 - require vendors 1 - $db_type"); is($products->[0]{'vendor'}{'vendor'}{'id'}, 1, "p2 - require vendors 2 - $db_type"); is($products->[0]{'vendor'}{'region'}{'name'}, 'America', "p2 - require vendors 3 - $db_type"); is($products->[1]{'vendor'}{'id'}, 3, "p3 - require vendors 1 - $db_type"); is($products->[1]{'vendor'}{'vendor'}{'id'}, 2, "p3 - require vendors 2 - $db_type"); is($products->[1]{'vendor'}{'region'}{'name'}, 'England', "p3 - require vendors 3 - $db_type"); # No-op join override tests my $last_sql; my $i = 1; foreach my $pair ([ [], [ 'vendor.vendor', 'vendor.region' ] ], [ [], [ 'vendor!.vendor', 'vendor.region' ] ], [ [], [ 'vendor.vendor!', 'vendor.region' ] ], [ [], [ 'vendor.vendor!', 'vendor!.region' ] ], [ [], [ 'vendor.vendor!', 'vendor.region!' ] ], [ [], [ 'vendor!.vendor', 'vendor.region!' ] ], [ [], [ 'vendor.vendor!', 'vendor!.region' ] ], [ [], [ 'vendor!.vendor!', 'vendor!.region!' ] ]) { my $sql = $manager_class->get_objects_sql( db => $db, debug => 1, (@{$pair->[0]} ? (with_objects => $pair->[0]) : ()), (@{$pair->[1]} ? (require_objects => $pair->[1]) : ())); $sql =~ s/\s+/ /g; if($last_sql) { is($sql, $last_sql, "join override no-op $i - $db_type"); } else { ok($sql, "join override $i - $db_type"); } $last_sql = $sql; $i++; } $i = 1; # Override tests my $sql = $manager_class->get_objects_sql( db => $db, with_objects => [ 'vendor.region!' ]); cmp_sql($sql, <<"EOF", "join override $i - $db_type"); SELECT t1.vendor_id, t1.name, t1.id, t2.region_id, t2.vendor_id, t2.name, t2.id, t3.name, t3.id FROM products t1 LEFT OUTER JOIN (vendors t2 JOIN regions t3 ON (t2.region_id = t3.id)) ON (t1.vendor_id = t2.id) EOF $i++; $sql = $manager_class->get_objects_sql( db => $db, with_objects => [ 'vendor.region' ]); cmp_sql($sql, <<"EOF", "join override $i - $db_type"); SELECT t1.vendor_id, t1.name, t1.id, t2.region_id, t2.vendor_id, t2.name, t2.id, t3.name, t3.id FROM products t1 LEFT OUTER JOIN vendors t2 ON (t1.vendor_id = t2.id) LEFT OUTER JOIN regions t3 ON (t2.region_id = t3.id) EOF $i++; $sql = $manager_class->get_objects_sql( db => $db, multi_many_ok => 1, with_objects => [ 'colors.description.authors.nicknames' ]); cmp_sql("$sql\n", <<"EOF", "join override $i - $db_type"); SELECT t1.vendor_id, t1.name, t1.id, t3.description_id, t3.name, t3.id, t4.text, t4.id, t6.name, t6.id, t7.author_id, t7.id, t7.nick FROM products t1 LEFT OUTER JOIN product_color_map t2 ON (t2.product_id = t1.id) LEFT OUTER JOIN colors t3 ON (t2.color_id = t3.id) LEFT OUTER JOIN descriptions t4 ON (t3.description_id = t4.id) LEFT OUTER JOIN description_author_map t5 ON (t5.description_id = t4.id) LEFT OUTER JOIN authors t6 ON (t5.author_id = t6.id) LEFT OUTER JOIN nicknames t7 ON (t6.id = t7.author_id) ORDER BY t1.id EOF #print STDERR "$sql\n"; $i++; $sql = $manager_class->get_objects_sql( db => $db, multi_many_ok => 1, with_objects => [ 'colors.description!.authors.nicknames!' ]); cmp_sql("$sql\n", <<"EOF", "join override $i - $db_type"); SELECT t1.vendor_id, t1.name, t1.id, t3.description_id, t3.name, t3.id, t4.text, t4.id, t6.name, t6.id, t7.author_id, t7.id, t7.nick FROM products t1 LEFT OUTER JOIN product_color_map t2 ON (t2.product_id = t1.id) LEFT OUTER JOIN (colors t3 JOIN descriptions t4 ON (t3.description_id = t4.id)) ON (t2.color_id = t3.id) LEFT OUTER JOIN description_author_map t5 ON (t5.description_id = t4.id) LEFT OUTER JOIN (authors t6 JOIN nicknames t7 ON (t6.id = t7.author_id)) ON (t5.author_id = t6.id) ORDER BY t1.id EOF #print STDERR "$sql\n"; $i++; $sql = $manager_class->get_objects_sql( db => $db, multi_many_ok => 1, require_objects => [ 'colors.description.authors.nicknames' ]); if($db->likes_implicit_joins) { cmp_sql("$sql\n", <<"EOF", "join override $i - $db_type"); SELECT t1.vendor_id, t1.name, t1.id, t3.description_id, t3.name, t3.id, t4.text, t4.id, t6.name, t6.id, t7.author_id, t7.nick, t7.id FROM products t1, product_color_map t2, colors t3, descriptions t4, description_author_map t5, authors t6, nicknames t7 WHERE t2.product_id = t1.id AND t2.color_id = t3.id AND t3.description_id = t4.id AND t5.description_id = t4.id AND t5.author_id = t6.id AND t6.id = t7.author_id ORDER BY t1.id EOF } else { cmp_sql("$sql\n", <<"EOF", "join override $i - $db_type"); SELECT t1.vendor_id, t1.name, t1.id, t3.description_id, t3.name, t3.id, t4.text, t4.id, t6.name, t6.id, t7.author_id, t7.id, t7.nick FROM products t1 JOIN (product_color_map t2 JOIN (colors t3 JOIN (descriptions t4 JOIN (description_author_map t5 JOIN (authors t6 JOIN nicknames t7 ON (t6.id = t7.author_id)) ON (t5.author_id = t6.id)) ON (t5.description_id = t4.id)) ON (t3.description_id = t4.id)) ON (t2.color_id = t3.id)) ON (t2.product_id = t1.id) ORDER BY t1.id EOF } #print STDERR "$sql\n"; $i++; $sql = $manager_class->get_objects_sql( db => $db, multi_many_ok => 1, require_objects => [ 'colors.description?.authors.nicknames?' ]); cmp_sql("$sql\n", <<"EOF", "join override $i - $db_type"); SELECT t1.vendor_id, t1.name, t1.id, t3.description_id, t3.name, t3.id, t4.text, t4.id, t6.name, t6.id, t7.author_id, t7.id, t7.nick FROM products t1 JOIN (product_color_map t2 JOIN colors t3 ON (t2.color_id = t3.id)) ON (t2.product_id = t1.id) LEFT OUTER JOIN (descriptions t4 JOIN (description_author_map t5 JOIN authors t6 ON (t5.author_id = t6.id)) ON (t5.description_id = t4.id)) ON (t3.description_id = t4.id) LEFT OUTER JOIN nicknames t7 ON (t6.id = t7.author_id) ORDER BY t1.id EOF #print STDERR "$sql\n"; # Conflict tests $i = 1; foreach my $pair ([ [], [ 'vendor.vendor', 'vendor?.region' ] ], [ [], [ 'vendor?.vendor', 'vendor.region' ] ], [ [], [ 'vendor?.vendor!', 'vendor!.region' ] ], [ [ 'vendor?.vendor' ], [ 'vendor.region' ] ], [ [ 'vendor.vendor' ], [ 'vendor!.region' ] ]) { eval { $manager_class->get_objects_sql( db => $db, debug => 1, (@{$pair->[0]} ? (with_objects => $pair->[0]) : ()), (@{$pair->[1]} ? (require_objects => $pair->[1]) : ())); }; ok($@, "join override conflict $i - $db_type"); $i++; } is(scalar @$products, 2, "require vendors 1 - $db_type"); is($products->[0]{'vendor'}{'id'}, 2, "p2 - require vendors 1 - $db_type"); is($products->[0]{'vendor'}{'vendor'}{'id'}, 1, "p2 - require vendors 2 - $db_type"); is($products->[0]{'vendor'}{'region'}{'name'}, 'America', "p2 - require vendors 3 - $db_type"); is($products->[1]{'vendor'}{'id'}, 3, "p3 - require vendors 1 - $db_type"); is($products->[1]{'vendor'}{'vendor'}{'id'}, 2, "p3 - require vendors 2 - $db_type"); is($products->[1]{'vendor'}{'region'}{'name'}, 'England', "p3 - require vendors 3 - $db_type"); $products = $manager_class->get_products( db => $db, require_objects => [ 'vendor.vendor', 'vendor.region' ], limit => 10, offset => 1); is(scalar @$products, 1, "offset require vendors 1 - $db_type"); is($products->[0]{'vendor'}{'id'}, 3, "p3 - offset require vendors 1 - $db_type"); is($products->[0]{'vendor'}{'vendor'}{'id'}, 2, "p3 - offset require vendors 2 - $db_type"); is($products->[0]{'vendor'}{'region'}{'name'}, 'England', "p3 - offset require vendors 3 - $db_type"); my $iterator = $manager_class->get_products_iterator( db => $db, require_objects => [ 'vendor.vendor', 'vendor.region' ]); my $p = $iterator->next; is($p->{'vendor'}{'id'}, 2, "p2 - require vendors iterator 1 - $db_type"); is($p->{'vendor'}{'vendor'}{'id'}, 1, "p2 - require vendors iterator 2 - $db_type"); is($p->{'vendor'}{'region'}{'name'}, 'America', "p2 - require vendors iterator 3 - $db_type"); $p = $iterator->next; is($p->{'vendor'}{'id'}, 3, "p3 - require vendors iterator 1 - $db_type"); is($p->{'vendor'}{'vendor'}{'id'}, 2, "p3 - require vendors iterator 2 - $db_type"); is($p->{'vendor'}{'region'}{'name'}, 'England', "p3 - require vendors iterator 3 - $db_type"); ok(!$iterator->next, "require vendors iterator 1 - $db_type"); is($iterator->total, 2, "require vendors iterator 2 - $db_type"); $iterator = $manager_class->get_products_iterator( db => $db, require_objects => [ 'vendor.vendor', 'vendor.region' ], limit => 10, offset => 1); $p = $iterator->next; is($p->{'vendor'}{'id'}, 3, "p3 - offset require vendors iterator 1 - $db_type"); is($p->{'vendor'}{'vendor'}{'id'}, 2, "p3 - offset require vendors iterator 2 - $db_type"); is($p->{'vendor'}{'region'}{'name'}, 'England', "p3 - offset require vendors iterator 3 - $db_type"); ok(!$iterator->next, "offset require vendors iterator 1 - $db_type"); is($iterator->total, 1, "offset require vendors iterator 2 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; $products = $manager_class->get_products( db => $db, with_objects => [ 'colors.description.authors.nicknames' ], multi_many_ok => 1, limit => 2, sort_by => [ 'colors.name DESC', 'authors.name' ]); is($products->[0]{'colors'}[0]{'name'}, 'red', "p1 - with colors 1 - $db_type"); is($products->[0]{'colors'}[1]{'name'}, 'blue', "p1 - with colors 2 - $db_type"); is(scalar @{$products->[0]{'colors'}}, 2, "p1 - with colors 3 - $db_type"); is($products->[0]{'colors'}[0]{'description'}{'text'}, 'desc 1', "p1 - with colors description 1 - $db_type"); is($products->[0]{'colors'}[1]{'description'}{'text'}, 'desc 2', "p1 - with colors description 2 - $db_type"); if(has_broken_order_by($db_type)) { $products->[0]{'colors'}[0]{'description'}{'authors'} = [ sort { $a->{'name'} cmp $b->{'name'} } @{$products->[0]{'colors'}[0]{'description'}{'authors'}} ]; } is($products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'name'}, 'john', "p1 - with colors description authors 1 - $db_type"); is($products->[0]{'colors'}[0]{'description'}{'authors'}[1]{'name'}, 'sue', "p1 - with colors description authors 2 - $db_type"); is(scalar @{$products->[0]{'colors'}[0]{'description'}{'authors'}}, 2, "p1 - with colors description authors 3 - $db_type"); if(has_broken_order_by($db_type)) { $products->[0]{'colors'}[1]{'description'}{'authors'} = [ sort { $a->{'name'} cmp $b->{'name'} } @{$products->[0]{'colors'}[1]{'description'}{'authors'}} ]; } is($products->[0]{'colors'}[1]{'description'}{'authors'}[0]{'name'}, 'jane', "p1 - with colors description authors 4 - $db_type"); is($products->[0]{'colors'}[1]{'description'}{'authors'}[1]{'name'}, 'john', "p1 - with colors description authors 5 - $db_type"); is(scalar @{$products->[0]{'colors'}[1]{'description'}{'authors'}}, 2, "p1 - with colors description authors 6 - $db_type"); $products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}} ]; is($products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[0]{'nick'}, 'jack', "p1 - with colors description authors nicknames 1 - $db_type"); is($products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[1]{'nick'}, 'sir', "p1 - with colors description authors nicknames 2 - $db_type"); is(scalar @{$products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}}, 2, "p1 - with colors description authors nicknames 3 - $db_type"); is($products->[0]{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}[0]{'nick'}, 'sioux', "p1 - with colors description authors nicknames 4 - $db_type"); is(scalar @{$products->[0]{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}}, 1, "p1 - with colors description authors nicknames 5 - $db_type"); $products->[0]{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$products->[0]{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'}} ]; is($products->[0]{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'}[0]{'nick'}, 'jack', "p1 - with colors description authors nicknames 6 - $db_type"); is($products->[0]{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'}[1]{'nick'}, 'sir', "p1 - with colors description authors nicknames 7 - $db_type"); is(scalar @{$products->[0]{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'}}, 2, "p1 - with colors description authors nicknames 8 - $db_type"); is($products->[0]{'colors'}[1]{'description'}{'authors'}[0]{'nicknames'}[0]{'nick'}, 'blub', "p1 - with colors description authors nicknames 9 - $db_type"); is(scalar @{$products->[0]{'colors'}[1]{'description'}{'authors'}[0]{'nicknames'}}, 1, "p1 - with colors description authors nicknames 10 - $db_type"); is($products->[1]{'colors'}[0]{'name'}, 'red', "p2 - with colors 1 - $db_type"); is($products->[1]{'colors'}[1]{'name'}, 'green', "p2 - with colors 2 - $db_type"); is(scalar @{$products->[1]{'colors'}}, 2, "p2 - with colors 3 - $db_type"); is($products->[1]{'colors'}[0]{'description'}{'text'}, 'desc 1', "p2 - with colors description 1 - $db_type"); is($products->[1]{'colors'}[1]{'description'}{'text'}, 'desc 3', "p2 - with colors description 2 - $db_type"); is($products->[1]{'colors'}[0]{'description'}{'authors'}[0]{'name'}, 'john', "p2 - with colors description authors 1 - $db_type"); is($products->[1]{'colors'}[0]{'description'}{'authors'}[1]{'name'}, 'sue', "p2 - with colors description authors 2 - $db_type"); is(scalar @{$products->[1]{'colors'}[0]{'description'}{'authors'}}, 2, "p2 - with colors description authors 3 - $db_type"); is($products->[1]{'colors'}[1]{'description'}{'authors'}[0]{'name'}, 'tim', "p2 - with colors description authors 4 - $db_type"); is(scalar @{$products->[1]{'colors'}[1]{'description'}{'authors'}}, 1, "p2 - with colors description authors 6 - $db_type"); $products->[1]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$products->[1]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}} ]; is($products->[1]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[0]{'nick'}, 'jack', "p2 - with colors description authors nicknames 1 - $db_type"); is($products->[1]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[1]{'nick'}, 'sir', "p2 - with colors description authors nicknames 2 - $db_type"); is(scalar @{$products->[1]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}}, 2, "p2 - with colors description authors nicknames 3 - $db_type"); is($products->[1]{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}[0]{'nick'}, 'sioux', "p2 - with colors description authors nicknames 4 - $db_type"); is(scalar @{$products->[1]{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}}, 1, "p2 - with colors description authors nicknames 5 - $db_type"); is(scalar @{$products->[1]{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'} || []}, 0, "p2 - with colors description authors nicknames 6 - $db_type"); $products = $manager_class->get_products( db => $db, with_objects => [ 'colors.description.authors.nicknames' ], multi_many_ok => 1, limit => 1, offset => 1, sort_by => [ 'colors.name DESC', 'authors.name' ]); is($products->[0]{'colors'}[0]{'name'}, 'red', "p2 - offset with colors 1 - $db_type"); is($products->[0]{'colors'}[1]{'name'}, 'green', "p2 - offset with colors 2 - $db_type"); is(scalar @{$products->[0]{'colors'}}, 2, "p2 - offset with colors 3 - $db_type"); is($products->[0]{'colors'}[0]{'description'}{'text'}, 'desc 1', "p2 - offset with colors description 1 - $db_type"); is($products->[0]{'colors'}[1]{'description'}{'text'}, 'desc 3', "p2 - offset with colors description 2 - $db_type"); is($products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'name'}, 'john', "p2 - offset with colors description authors 1 - $db_type"); is($products->[0]{'colors'}[0]{'description'}{'authors'}[1]{'name'}, 'sue', "p2 - offset with colors description authors 2 - $db_type"); is(scalar @{$products->[0]{'colors'}[0]{'description'}{'authors'}}, 2, "p2 - offset with colors description authors 3 - $db_type"); is($products->[0]{'colors'}[1]{'description'}{'authors'}[0]{'name'}, 'tim', "p2 - offset with colors description authors 4 - $db_type"); is(scalar @{$products->[0]{'colors'}[1]{'description'}{'authors'}}, 1, "p2 - offset with colors description authors 6 - $db_type"); $products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}} ]; is($products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[0]{'nick'}, 'jack', "p2 - offset with colors description authors nicknames 1 - $db_type"); is($products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[1]{'nick'}, 'sir', "p2 - offset with colors description authors nicknames 2 - $db_type"); is(scalar @{$products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}}, 2, "p2 - offset with colors description authors nicknames 3 - $db_type"); is($products->[0]{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}[0]{'nick'}, 'sioux', "p2 - offset with colors description authors nicknames 4 - $db_type"); is(scalar @{$products->[0]{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}}, 1, "p2 - offset with colors description authors nicknames 5 - $db_type"); is(scalar @{$products->[0]{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'} || []}, 0, "p2 - offset with colors description authors nicknames 6 - $db_type"); $products = $manager_class->get_products( db => $db, with_objects => [ 'colors.description.authors.nicknames' ], multi_many_ok => 1, limit => 1, offset => 1, sort_by => [ 'colors.name DESC', 'authors.name' ]); Rose::DB::Object::Helpers::strip($products->[0], leave => [ 'related_objects' ]); Rose::DB::Object::Helpers::strip($products->[0], leave => 'foreign_keys'); Rose::DB::Object::Helpers::strip($products->[0], leave => [ 'relationships' ]); Rose::DB::Object::Helpers::strip($products->[0]); $iterator = $manager_class->get_products_iterator( db => $db, with_objects => [ 'colors.description.authors.nicknames' ], multi_many_ok => 1, limit => 2, sort_by => [ 'colors.name DESC', 'authors.name' ]); $p = $iterator->next; is($p->{'colors'}[0]{'name'}, 'red', "p1 - iterator with colors 1 - $db_type"); is($p->{'colors'}[1]{'name'}, 'blue', "p1 - iterator with colors 2 - $db_type"); is(scalar @{$p->{'colors'}}, 2, "p1 - iterator with colors 3 - $db_type"); is($p->{'colors'}[0]{'description'}{'text'}, 'desc 1', "p1 - iterator with colors description 1 - $db_type"); is($p->{'colors'}[1]{'description'}{'text'}, 'desc 2', "p1 - iterator with colors description 2 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[0]{'name'}, 'john', "p1 - iterator with colors description authors 1 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[1]{'name'}, 'sue', "p1 - iterator with colors description authors 2 - $db_type"); is(scalar @{$p->{'colors'}[0]{'description'}{'authors'}}, 2, "p1 - iterator with colors description authors 3 - $db_type"); if(has_broken_order_by($db_type)) { $p->{'colors'}[1]{'description'}{'authors'} = [ sort { $a->{'name'} cmp $b->{'name'} } @{$p->{'colors'}[1]{'description'}{'authors'}} ]; } is($p->{'colors'}[1]{'description'}{'authors'}[0]{'name'}, 'jane', "p1 - iterator with colors description authors 4 - $db_type"); is($p->{'colors'}[1]{'description'}{'authors'}[1]{'name'}, 'john', "p1 - iterator with colors description authors 5 - $db_type"); is(scalar @{$p->{'colors'}[1]{'description'}{'authors'}}, 2, "p1 - iterator with colors description authors 6 - $db_type"); $p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}} ]; is($p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[0]{'nick'}, 'jack', "p1 - iterator with colors description authors nicknames 1 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[1]{'nick'}, 'sir', "p1 - iterator with colors description authors nicknames 2 - $db_type"); is(scalar @{$p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}}, 2, "p1 - iterator with colors description authors nicknames 3 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}[0]{'nick'}, 'sioux', "p1 - iterator with colors description authors nicknames 4 - $db_type"); is(scalar @{$p->{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}}, 1, "p1 - iterator with colors description authors nicknames 5 - $db_type"); $p->{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$p->{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'}} ]; is($p->{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'}[0]{'nick'}, 'jack', "p1 - iterator with colors description authors nicknames 6 - $db_type"); is($p->{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'}[1]{'nick'}, 'sir', "p1 - iterator with colors description authors nicknames 7 - $db_type"); is(scalar @{$p->{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'}}, 2, "p1 - iterator with colors description authors nicknames 8 - $db_type"); is($p->{'colors'}[1]{'description'}{'authors'}[0]{'nicknames'}[0]{'nick'}, 'blub', "p1 - iterator with colors description authors nicknames 9 - $db_type"); is(scalar @{$p->{'colors'}[1]{'description'}{'authors'}[0]{'nicknames'}}, 1, "p1 - iterator with colors description authors nicknames 10 - $db_type"); $p = $iterator->next; is($p->{'colors'}[0]{'name'}, 'red', "p2 - iterator with colors 1 - $db_type"); is($p->{'colors'}[1]{'name'}, 'green', "p2 - iterator with colors 2 - $db_type"); is(scalar @{$p->{'colors'}}, 2, "p2 - iterator with colors 3 - $db_type"); is($p->{'colors'}[0]{'description'}{'text'}, 'desc 1', "p2 - iterator with colors description 1 - $db_type"); is($p->{'colors'}[1]{'description'}{'text'}, 'desc 3', "p2 - iterator with colors description 2 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[0]{'name'}, 'john', "p2 - iterator with colors description authors 1 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[1]{'name'}, 'sue', "p2 - iterator with colors description authors 2 - $db_type"); is(scalar @{$p->{'colors'}[0]{'description'}{'authors'}}, 2, "p2 - iterator with colors description authors 3 - $db_type"); is($p->{'colors'}[1]{'description'}{'authors'}[0]{'name'}, 'tim', "p2 - iterator with colors description authors 4 - $db_type"); is(scalar @{$p->{'colors'}[1]{'description'}{'authors'}}, 1, "p2 - iterator with colors description authors 6 - $db_type"); $p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}} ]; is($p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[0]{'nick'}, 'jack', "p2 - iterator with colors description authors nicknames 1 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[1]{'nick'}, 'sir', "p2 - iterator with colors description authors nicknames 2 - $db_type"); is(scalar @{$p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}}, 2, "p2 - iterator with colors description authors nicknames 3 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}[0]{'nick'}, 'sioux', "p2 - iterator with colors description authors nicknames 4 - $db_type"); is(scalar @{$p->{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}}, 1, "p2 - iterator with colors description authors nicknames 5 - $db_type"); is(scalar @{$p->{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'} || []}, 0, "p2 - iterator with colors description authors nicknames 6 - $db_type"); ok(!$iterator->next, "iterator with colors description authors nicknames 1 - $db_type"); is($iterator->total, 2, "iterator with colors description authors nicknames 2 - $db_type"); $iterator = $manager_class->get_products_iterator( db => $db, with_objects => [ 'colors.description.authors.nicknames' ], multi_many_ok => 1, limit => 1, offset => 1, sort_by => [ 'colors.name DESC', 'authors.name' ]); $p = $iterator->next; is($p->{'colors'}[0]{'name'}, 'red', "p2 - offset iterator with colors 1 - $db_type"); is($p->{'colors'}[1]{'name'}, 'green', "p2 - offset iterator with colors 2 - $db_type"); is(scalar @{$p->{'colors'}}, 2, "p2 - offset iterator with colors 3 - $db_type"); is($p->{'colors'}[0]{'description'}{'text'}, 'desc 1', "p2 - offset iterator with colors description 1 - $db_type"); is($p->{'colors'}[1]{'description'}{'text'}, 'desc 3', "p2 - offset iterator with colors description 2 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[0]{'name'}, 'john', "p2 - offset iterator with colors description authors 1 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[1]{'name'}, 'sue', "p2 - offset iterator with colors description authors 2 - $db_type"); is(scalar @{$p->{'colors'}[0]{'description'}{'authors'}}, 2, "p2 - offset iterator with colors description authors 3 - $db_type"); is($p->{'colors'}[1]{'description'}{'authors'}[0]{'name'}, 'tim', "p2 - offset iterator with colors description authors 4 - $db_type"); is(scalar @{$p->{'colors'}[1]{'description'}{'authors'}}, 1, "p2 - offset iterator with colors description authors 6 - $db_type"); $p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}} ]; is($p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[0]{'nick'}, 'jack', "p2 - offset iterator with colors description authors nicknames 1 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[1]{'nick'}, 'sir', "p2 - offset iterator with colors description authors nicknames 2 - $db_type"); is(scalar @{$p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}}, 2, "p2 - offset iterator with colors description authors nicknames 3 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}[0]{'nick'}, 'sioux', "p2 - offset iterator with colors description authors nicknames 4 - $db_type"); is(scalar @{$p->{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}}, 1, "p2 - offset iterator with colors description authors nicknames 5 - $db_type"); is(scalar @{$p->{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'} || []}, 0, "p2 - offset iterator with colors description authors nicknames 6 - $db_type"); ok(!$iterator->next, "offset iterator with colors description authors nicknames 1 - $db_type"); is($iterator->total, 1, "offset iterator with colors description authors nicknames 2 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; $products = $manager_class->get_products( db => $db, require_objects => [ 'vendor.region', 'prices.region' ], with_objects => [ 'colors.description.authors.nicknames' ], multi_many_ok => 1, limit => 2, sort_by => [ 'colors.name DESC', 'authors.name' ]); #exit; is($products->[0]{'vendor'}{'name'}, 'V1', "p1 - vendor 1 - $db_type"); is($products->[0]{'vendor'}{'region'}{'name'}, 'Germany', "p1 - vendor 2 - $db_type"); is($products->[1]{'vendor'}{'name'}, 'V2', "p2 - vendor 1 - $db_type"); is($products->[1]{'vendor'}{'region'}{'name'}, 'America', "p2 - vendor 2 - $db_type"); is(scalar @{$products->[0]{'prices'}}, 2, "p1 - prices 1 - $db_type"); is(scalar @{$products->[1]{'prices'}}, 1, "p2 - prices 2 - $db_type"); $products->[0]{'prices'} = [ sort { $a->{'price'} <=> $b->{'price'} } @{$products->[0]{'prices'}} ]; $products->[1]{'prices'} = [ sort { $a->{'price'} <=> $b->{'price'} } @{$products->[1]{'prices'}} ]; is($products->[0]{'prices'}[0]{'price'}, 1.25, "p1 - prices 2 - $db_type"); is($products->[0]{'prices'}[0]{'region'}{'name'}, 'America', "p1 - prices 3 - $db_type"); is($products->[0]{'prices'}[1]{'price'}, 4.25, "p1 - prices 4 - $db_type"); is($products->[0]{'prices'}[1]{'region'}{'name'}, 'Germany', "p1 - prices 5 - $db_type"); is($products->[1]{'prices'}[0]{'price'}, 9.25, "p2 - prices 2 - $db_type"); is($products->[1]{'prices'}[0]{'region'}{'name'}, 'America', "p2 - prices 3 - $db_type"); if(has_broken_order_by($db_type)) { $products->[0]{'colors'} = [ sort { $b->{'name'} cmp $a->{'name'} } @{$products->[0]{'colors'}} ]; $products->[0]{'colors'}[0]{'description'}{'authors'} = [ sort { $a->{'name'} cmp $b->{'name'} } @{$products->[0]{'colors'}[0]{'description'}{'authors'}} ]; $products->[0]{'colors'}[1]{'description'}{'authors'} = [ sort { $a->{'name'} cmp $b->{'name'} } @{$products->[0]{'colors'}[1]{'description'}{'authors'}} ]; } is($products->[0]{'colors'}[0]{'name'}, 'red', "p1 - with colors vendors 1 - $db_type"); is($products->[0]{'colors'}[1]{'name'}, 'blue', "p1 - with colors vendors 2 - $db_type"); is(scalar @{$products->[0]{'colors'}}, 2, "p1 - with colors vendors 3 - $db_type"); is($products->[0]{'colors'}[0]{'description'}{'text'}, 'desc 1', "p1 - with colors vendors description 1 - $db_type"); is($products->[0]{'colors'}[1]{'description'}{'text'}, 'desc 2', "p1 - with colors vendors description 2 - $db_type"); is($products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'name'}, 'john', "p1 - with colors vendors description authors 1 - $db_type"); is($products->[0]{'colors'}[0]{'description'}{'authors'}[1]{'name'}, 'sue', "p1 - with colors vendors description authors 2 - $db_type"); is(scalar @{$products->[0]{'colors'}[0]{'description'}{'authors'}}, 2, "p1 - with colors vendors description authors 3 - $db_type"); is($products->[0]{'colors'}[1]{'description'}{'authors'}[0]{'name'}, 'jane', "p1 - with colors vendors description authors 4 - $db_type"); is($products->[0]{'colors'}[1]{'description'}{'authors'}[1]{'name'}, 'john', "p1 - with colors vendors description authors 5 - $db_type"); is(scalar @{$products->[0]{'colors'}[1]{'description'}{'authors'}}, 2, "p1 - with colors vendors description authors 6 - $db_type"); $products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'} = [ sort { $b->{'nick'} cmp $a->{'nick'} } @{$products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}} ]; is($products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[0]{'nick'}, 'sir', "p1 - with colors vendors description authors nicknames 1 - $db_type"); is($products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[1]{'nick'}, 'jack', "p1 - with colors vendors description authors nicknames 2 - $db_type"); is(scalar @{$products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}}, 2, "p1 - with colors vendors description authors nicknames 3 - $db_type"); is($products->[0]{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}[0]{'nick'}, 'sioux', "p1 - with colors vendors description authors nicknames 4 - $db_type"); is(scalar @{$products->[0]{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}}, 1, "p1 - with colors vendors description authors nicknames 5 - $db_type"); $products->[0]{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'} = [ sort { $b->{'nick'} cmp $a->{'nick'} } @{$products->[0]{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'}} ]; is($products->[0]{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'}[0]{'nick'}, 'sir', "p1 - with colors vendors description authors nicknames 6 - $db_type"); is($products->[0]{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'}[1]{'nick'}, 'jack', "p1 - with colors vendors description authors nicknames 7 - $db_type"); is(scalar @{$products->[0]{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'}}, 2, "p1 - with colors vendors description authors nicknames 8 - $db_type"); is($products->[0]{'colors'}[1]{'description'}{'authors'}[0]{'nicknames'}[0]{'nick'}, 'blub', "p1 - with colors vendors description authors nicknames 9 - $db_type"); is(scalar @{$products->[0]{'colors'}[1]{'description'}{'authors'}[0]{'nicknames'}}, 1, "p1 - with colors vendors description authors nicknames 10 - $db_type"); is($products->[1]{'colors'}[0]{'name'}, 'red', "p2 - with colors vendors 1 - $db_type"); is($products->[1]{'colors'}[1]{'name'}, 'green', "p2 - with colors vendors 2 - $db_type"); is(scalar @{$products->[1]{'colors'}}, 2, "p2 - with colors vendors 3 - $db_type"); is($products->[1]{'colors'}[0]{'description'}{'text'}, 'desc 1', "p2 - with colors vendors description 1 - $db_type"); is($products->[1]{'colors'}[1]{'description'}{'text'}, 'desc 3', "p2 - with colors vendors description 2 - $db_type"); is($products->[1]{'colors'}[0]{'description'}{'authors'}[0]{'name'}, 'john', "p2 - with colors vendors description authors 1 - $db_type"); is($products->[1]{'colors'}[0]{'description'}{'authors'}[1]{'name'}, 'sue', "p2 - with colors vendors description authors 2 - $db_type"); is(scalar @{$products->[1]{'colors'}[0]{'description'}{'authors'}}, 2, "p2 - with colors vendors description authors 3 - $db_type"); is($products->[1]{'colors'}[1]{'description'}{'authors'}[0]{'name'}, 'tim', "p2 - with colors vendors description authors 4 - $db_type"); is(scalar @{$products->[1]{'colors'}[1]{'description'}{'authors'}}, 1, "p2 - with colors vendors description authors 6 - $db_type"); $products->[1]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$products->[1]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}} ]; is($products->[1]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[0]{'nick'}, 'jack', "p2 - with colors vendors description authors nicknames 1 - $db_type"); is($products->[1]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[1]{'nick'}, 'sir', "p2 - with colors vendors description authors nicknames 2 - $db_type"); is(scalar @{$products->[1]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}}, 2, "p2 - with colors vendors description authors nicknames 3 - $db_type"); is($products->[1]{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}[0]{'nick'}, 'sioux', "p2 - with colors vendors description authors nicknames 4 - $db_type"); is(scalar @{$products->[1]{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}}, 1, "p2 - with colors vendors description authors nicknames 5 - $db_type"); is(scalar @{$products->[1]{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'} || []}, 0, "p2 - with colors vendors description authors nicknames 6 - $db_type"); $products = $manager_class->get_products( db => $db, require_objects => [ 'vendor.region', 'prices.region' ], with_objects => [ 'colors.description.authors.nicknames' ], multi_many_ok => 1, limit => 1, offset => 1, sort_by => [ 'colors.name DESC', 'authors.name' ]); is($products->[0]{'vendor'}{'name'}, 'V2', "p2 - offset vendor 1 - $db_type"); is($products->[0]{'vendor'}{'region'}{'name'}, 'America', "p2 - offset vendor 2 - $db_type"); is(scalar @{$products->[0]{'prices'}}, 1, "p1 - offset prices 1 - $db_type"); $products->[0]{'prices'} = [ sort { $a->{'price'} <=> $b->{'price'} } @{$products->[0]{'prices'}} ]; is($products->[0]{'prices'}[0]{'price'}, 9.25, "p2 - offset prices 2 - $db_type"); is($products->[0]{'prices'}[0]{'region'}{'name'}, 'America', "p2 - offset prices 3 - $db_type"); is($products->[0]{'colors'}[0]{'name'}, 'red', "p2 - offset with colors vendors 1 - $db_type"); is($products->[0]{'colors'}[1]{'name'}, 'green', "p2 - offset with colors vendors 2 - $db_type"); is(scalar @{$products->[0]{'colors'}}, 2, "p2 - offset with colors vendors 3 - $db_type"); is($products->[0]{'colors'}[0]{'description'}{'text'}, 'desc 1', "p2 - offset with colors vendors description 1 - $db_type"); is($products->[0]{'colors'}[1]{'description'}{'text'}, 'desc 3', "p2 - offset with colors vendors description 2 - $db_type"); is($products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'name'}, 'john', "p2 - offset with colors vendors description authors 1 - $db_type"); is($products->[0]{'colors'}[0]{'description'}{'authors'}[1]{'name'}, 'sue', "p2 - offset with colors vendors description authors 2 - $db_type"); is(scalar @{$products->[0]{'colors'}[0]{'description'}{'authors'}}, 2, "p2 - offset with colors vendors description authors 3 - $db_type"); is($products->[0]{'colors'}[1]{'description'}{'authors'}[0]{'name'}, 'tim', "p2 - offset with colors vendors description authors 4 - $db_type"); is(scalar @{$products->[0]{'colors'}[1]{'description'}{'authors'}}, 1, "p2 - offset with colors vendors description authors 6 - $db_type"); $products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}} ]; is($products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[0]{'nick'}, 'jack', "p2 - offset with colors vendors description authors nicknames 1 - $db_type"); is($products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[1]{'nick'}, 'sir', "p2 - offset with colors vendors description authors nicknames 2 - $db_type"); is(scalar @{$products->[0]{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}}, 2, "p2 - offset with colors vendors description authors nicknames 3 - $db_type"); is($products->[0]{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}[0]{'nick'}, 'sioux', "p2 - offset with colors vendors description authors nicknames 4 - $db_type"); is(scalar @{$products->[0]{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}}, 1, "p2 - offset with colors vendors description authors nicknames 5 - $db_type"); is(scalar @{$products->[0]{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'} || []}, 0, "p2 - offset with colors vendors description authors nicknames 6 - $db_type"); $iterator = $manager_class->get_products_iterator( db => $db, require_objects => [ 'vendor.region', 'prices.region' ], with_objects => [ 'colors.description.authors.nicknames' ], multi_many_ok => 1, limit => 2, sort_by => [ 'colors.name DESC', 'authors.name' ]); $p = $iterator->next; is($p->{'vendor'}{'name'}, 'V1', "p1 - iterator vendor 1 - $db_type"); is($p->{'vendor'}{'region'}{'name'}, 'Germany', "p1 - iterator vendor 2 - $db_type"); is(scalar @{$p->{'prices'}}, 2, "p1 - iterator prices 1 - $db_type"); $p->{'prices'} = [ sort { $a->{'price'} <=> $b->{'price'} } @{$p->{'prices'}} ]; is($p->{'prices'}[0]{'price'}, 1.25, "p1 - iterator prices 2 - $db_type"); is($p->{'prices'}[0]{'region'}{'name'}, 'America', "p1 - iterator prices 3 - $db_type"); is($p->{'prices'}[1]{'price'}, 4.25, "p1 - iterator prices 4 - $db_type"); is($p->{'prices'}[1]{'region'}{'name'}, 'Germany', "p1 - iterator prices 5 - $db_type"); is($p->{'colors'}[0]{'name'}, 'red', "p1 - iterator with colors vendors 1 - $db_type"); is($p->{'colors'}[1]{'name'}, 'blue', "p1 - iterator with colors vendors 2 - $db_type"); is(scalar @{$p->{'colors'}}, 2, "p1 - iterator with colors vendors 3 - $db_type"); is($p->{'colors'}[0]{'description'}{'text'}, 'desc 1', "p1 - iterator with colors vendors description 1 - $db_type"); is($p->{'colors'}[1]{'description'}{'text'}, 'desc 2', "p1 - iterator with colors vendors description 2 - $db_type"); if(has_broken_order_by($db_type)) { $p->{'colors'}[0]{'description'}{'authors'} = [ sort { $a->{'name'} cmp $b->{'name'} } @{$p->{'colors'}[0]{'description'}{'authors'}} ]; $p->{'colors'}[1]{'description'}{'authors'} = [ sort { $a->{'name'} cmp $b->{'name'} } @{$p->{'colors'}[1]{'description'}{'authors'}} ]; } is($p->{'colors'}[0]{'description'}{'authors'}[0]{'name'}, 'john', "p1 - iterator with colors vendors description authors 1 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[1]{'name'}, 'sue', "p1 - iterator with colors vendors description authors 2 - $db_type"); is(scalar @{$p->{'colors'}[0]{'description'}{'authors'}}, 2, "p1 - iterator with colors vendors description authors 3 - $db_type"); is($p->{'colors'}[1]{'description'}{'authors'}[0]{'name'}, 'jane', "p1 - iterator with colors vendors description authors 4 - $db_type"); is($p->{'colors'}[1]{'description'}{'authors'}[1]{'name'}, 'john', "p1 - iterator with colors vendors description authors 5 - $db_type"); is(scalar @{$p->{'colors'}[1]{'description'}{'authors'}}, 2, "p1 - iterator with colors vendors description authors 6 - $db_type"); $p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'} = [ sort { $b->{'nick'} cmp $a->{'nick'} } @{$p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}} ]; $p->{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'} = [ sort { $b->{'nick'} cmp $a->{'nick'} } @{$p->{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'}} ]; is($p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[0]{'nick'}, 'sir', "p1 - iterator with colors vendors description authors nicknames 1 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[1]{'nick'}, 'jack', "p1 - iterator with colors vendors description authors nicknames 2 - $db_type"); is(scalar @{$p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}}, 2, "p1 - iterator with colors vendors description authors nicknames 3 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}[0]{'nick'}, 'sioux', "p1 - iterator with colors vendors description authors nicknames 4 - $db_type"); is(scalar @{$p->{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}}, 1, "p1 - iterator with colors vendors description authors nicknames 5 - $db_type"); is($p->{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'}[0]{'nick'}, 'sir', "p1 - iterator with colors vendors description authors nicknames 6 - $db_type"); is($p->{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'}[1]{'nick'}, 'jack', "p1 - iterator with colors vendors description authors nicknames 7 - $db_type"); is(scalar @{$p->{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'}}, 2, "p1 - iterator with colors vendors description authors nicknames 8 - $db_type"); is($p->{'colors'}[1]{'description'}{'authors'}[0]{'nicknames'}[0]{'nick'}, 'blub', "p1 - iterator with colors vendors description authors nicknames 9 - $db_type"); is(scalar @{$p->{'colors'}[1]{'description'}{'authors'}[0]{'nicknames'}}, 1, "p1 - iterator with colors vendors description authors nicknames 10 - $db_type"); $p = $iterator->next; is($p->{'vendor'}{'name'}, 'V2', "p2 - iterator vendor 1 - $db_type"); is($p->{'vendor'}{'region'}{'name'}, 'America', "p2 - iterator vendor 2 - $db_type"); $p->{'prices'} = [ sort { $a->{'price'} <=> $b->{'price'} } @{$p->{'prices'}} ]; is(scalar @{$p->{'prices'}}, 1, "p2 - iterator prices 2 - $db_type"); is($p->{'prices'}[0]{'price'}, 9.25, "p2 - iterator prices 2 - $db_type"); is($p->{'prices'}[0]{'region'}{'name'}, 'America', "p2 - iterator prices 3 - $db_type"); is($p->{'colors'}[0]{'name'}, 'red', "p2 - iterator with colors vendors 1 - $db_type"); is($p->{'colors'}[1]{'name'}, 'green', "p2 - iterator with colors vendors 2 - $db_type"); is(scalar @{$p->{'colors'}}, 2, "p2 - iterator with colors vendors 3 - $db_type"); is($p->{'colors'}[0]{'description'}{'text'}, 'desc 1', "p2 - iterator with colors vendors description 1 - $db_type"); is($p->{'colors'}[1]{'description'}{'text'}, 'desc 3', "p2 - iterator with colors vendors description 2 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[0]{'name'}, 'john', "p2 - iterator with colors vendors description authors 1 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[1]{'name'}, 'sue', "p2 - iterator with colors vendors description authors 2 - $db_type"); is(scalar @{$p->{'colors'}[0]{'description'}{'authors'}}, 2, "p2 - iterator with colors vendors description authors 3 - $db_type"); is($p->{'colors'}[1]{'description'}{'authors'}[0]{'name'}, 'tim', "p2 - iterator with colors vendors description authors 4 - $db_type"); is(scalar @{$p->{'colors'}[1]{'description'}{'authors'}}, 1, "p2 - iterator with colors vendors description authors 6 - $db_type"); $p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}} ]; is($p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[0]{'nick'}, 'jack', "p2 - iterator with colors vendors description authors nicknames 1 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[1]{'nick'}, 'sir', "p2 - iterator with colors vendors description authors nicknames 2 - $db_type"); is(scalar @{$p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}}, 2, "p2 - iterator with colors vendors description authors nicknames 3 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}[0]{'nick'}, 'sioux', "p2 - iterator with colors vendors description authors nicknames 4 - $db_type"); is(scalar @{$p->{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}}, 1, "p2 - iterator with colors vendors description authors nicknames 5 - $db_type"); is(scalar @{$p->{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'} || []}, 0, "p2 - iterator with colors vendors description authors nicknames 6 - $db_type"); $iterator = $manager_class->get_products_iterator( db => $db, require_objects => [ 'vendor.region', 'prices.region' ], with_objects => [ 'colors.description.authors.nicknames' ], multi_many_ok => 1, limit => 1, offset => 1, sort_by => [ 'colors.name DESC', 'authors.name' ]); $p = $iterator->next; is($p->{'vendor'}{'name'}, 'V2', "p2 - offset iterator vendor 1 - $db_type"); is($p->{'vendor'}{'region'}{'name'}, 'America', "p2 - offset iterator vendor 2 - $db_type"); $p->{'prices'} = [ sort { $a->{'price'} <=> $b->{'price'} } @{$p->{'prices'}} ]; is(scalar @{$p->{'prices'}}, 1, "p2 - offset iterator prices 2 - $db_type"); is($p->{'prices'}[0]{'price'}, 9.25, "p2 - offset iterator prices 2 - $db_type"); is($p->{'prices'}[0]{'region'}{'name'}, 'America', "p2 - offset iterator prices 3 - $db_type"); is($p->{'colors'}[0]{'name'}, 'red', "p2 - offset iterator with colors vendors 1 - $db_type"); is($p->{'colors'}[1]{'name'}, 'green', "p2 - offset iterator with colors vendors 2 - $db_type"); is(scalar @{$p->{'colors'}}, 2, "p2 - offset iterator with colors vendors 3 - $db_type"); is($p->{'colors'}[0]{'description'}{'text'}, 'desc 1', "p2 - offset iterator with colors vendors description 1 - $db_type"); is($p->{'colors'}[1]{'description'}{'text'}, 'desc 3', "p2 - offset iterator with colors vendors description 2 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[0]{'name'}, 'john', "p2 - offset iterator with colors vendors description authors 1 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[1]{'name'}, 'sue', "p2 - offset iterator with colors vendors description authors 2 - $db_type"); is(scalar @{$p->{'colors'}[0]{'description'}{'authors'}}, 2, "p2 - offset iterator with colors vendors description authors 3 - $db_type"); is($p->{'colors'}[1]{'description'}{'authors'}[0]{'name'}, 'tim', "p2 - offset iterator with colors vendors description authors 4 - $db_type"); is(scalar @{$p->{'colors'}[1]{'description'}{'authors'}}, 1, "p2 - offset iterator with colors vendors description authors 6 - $db_type"); $p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}} ]; is($p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[0]{'nick'}, 'jack', "p2 - offset iterator with colors vendors description authors nicknames 1 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[1]{'nick'}, 'sir', "p2 - offset iterator with colors vendors description authors nicknames 2 - $db_type"); is(scalar @{$p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}}, 2, "p2 - offset iterator with colors vendors description authors nicknames 3 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}[0]{'nick'}, 'sioux', "p2 - offset iterator with colors vendors description authors nicknames 4 - $db_type"); is(scalar @{$p->{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}}, 1, "p2 - offset iterator with colors vendors description authors nicknames 5 - $db_type"); is(scalar @{$p->{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'} || []}, 0, "p2 - offset iterator with colors vendors description authors nicknames 6 - $db_type"); ok(!$iterator->next, "offset iterator with colors vendors description authors nicknames 1 - $db_type"); is($iterator->total, 1, "offset iterator with colors vendors description authors nicknames 2 - $db_type"); #local $Rose::DB::Object::Manager::Debug = 1; $iterator = $manager_class->get_products_iterator( db => $db, require_objects => [ 'vendor.region', 'prices.region' ], with_objects => [ 'colors.description.authors.nicknames' ], multi_many_ok => 1, query => [ 'vendor.region.name' => 'America' ], sort_by => [ 'colors.name DESC', 'authors.name' ]); $p = $iterator->next; is($p->{'vendor'}{'name'}, 'V2', "p2 - query iterator vendor 1 - $db_type"); is($p->{'vendor'}{'region'}{'name'}, 'America', "p2 - query iterator vendor 2 - $db_type"); $p->{'prices'} = [ sort { $a->{'price'} <=> $b->{'price'} } @{$p->{'prices'}} ]; is(scalar @{$p->{'prices'}}, 1, "p2 - query iterator prices 2 - $db_type"); is($p->{'prices'}[0]{'price'}, 9.25, "p2 - query iterator prices 2 - $db_type"); is($p->{'prices'}[0]{'region'}{'name'}, 'America', "p2 - query iterator prices 3 - $db_type"); is($p->{'colors'}[0]{'name'}, 'red', "p2 - query iterator with colors vendors 1 - $db_type"); is($p->{'colors'}[1]{'name'}, 'green', "p2 - query iterator with colors vendors 2 - $db_type"); is(scalar @{$p->{'colors'}}, 2, "p2 - query iterator with colors vendors 3 - $db_type"); is($p->{'colors'}[0]{'description'}{'text'}, 'desc 1', "p2 - query iterator with colors vendors description 1 - $db_type"); is($p->{'colors'}[1]{'description'}{'text'}, 'desc 3', "p2 - query iterator with colors vendors description 2 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[0]{'name'}, 'john', "p2 - query iterator with colors vendors description authors 1 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[1]{'name'}, 'sue', "p2 - query iterator with colors vendors description authors 2 - $db_type"); is(scalar @{$p->{'colors'}[0]{'description'}{'authors'}}, 2, "p2 - query iterator with colors vendors description authors 3 - $db_type"); is($p->{'colors'}[1]{'description'}{'authors'}[0]{'name'}, 'tim', "p2 - query iterator with colors vendors description authors 4 - $db_type"); is(scalar @{$p->{'colors'}[1]{'description'}{'authors'}}, 1, "p2 - query iterator with colors vendors description authors 6 - $db_type"); $p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'} = [ sort { $a->{'nick'} cmp $b->{'nick'} } @{$p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}} ]; is($p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[0]{'nick'}, 'jack', "p2 - query iterator with colors vendors description authors nicknames 1 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}[1]{'nick'}, 'sir', "p2 - query iterator with colors vendors description authors nicknames 2 - $db_type"); is(scalar @{$p->{'colors'}[0]{'description'}{'authors'}[0]{'nicknames'}}, 2, "p2 - query iterator with colors vendors description authors nicknames 3 - $db_type"); is($p->{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}[0]{'nick'}, 'sioux', "p2 - query iterator with colors vendors description authors nicknames 4 - $db_type"); is(scalar @{$p->{'colors'}[0]{'description'}{'authors'}[1]{'nicknames'}}, 1, "p2 - query iterator with colors vendors description authors nicknames 5 - $db_type"); is(scalar @{$p->{'colors'}[1]{'description'}{'authors'}[1]{'nicknames'} || []}, 0, "p2 - query iterator with colors vendors description authors nicknames 6 - $db_type"); ok(!$iterator->next, "query iterator with colors vendors description authors nicknames 1 - $db_type"); is($iterator->total, 1, "query iterator with colors vendors description authors nicknames 2 - $db_type"); # End test of the subselect limit code #Rose::DB::Object::Manager->default_limit_with_subselect(0); } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; #die "This test chokes DBD::Pg version 2.1.x and 2.2.0" if($DBD::Pg::VERSION =~ /^2\.(?:1\.|2\.0)/); }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE description_author_map CASCADE'); $dbh->do('DROP TABLE nicknames CASCADE'); $dbh->do('DROP TABLE authors CASCADE'); $dbh->do('DROP TABLE descriptions CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE regions CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.product_color_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.description_author_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.nicknames CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.authors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.descriptions CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.regions CASCADE'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); } $dbh->do(<<"EOF"); CREATE TABLE regions ( id CHAR(2) NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, vendor_id INT REFERENCES vendors (id), region_id CHAR(2) REFERENCES regions (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, vendor_id INT REFERENCES vendors (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region_id CHAR(2) NOT NULL REFERENCES regions (id) DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE descriptions ( id SERIAL NOT NULL PRIMARY KEY, text VARCHAR(255) NOT NULL, UNIQUE(text) ) EOF $dbh->do(<<"EOF"); CREATE TABLE authors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE nicknames ( id SERIAL NOT NULL PRIMARY KEY, nick VARCHAR(255) NOT NULL, author_id INT REFERENCES authors (id), UNIQUE(nick, author_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE description_author_map ( description_id INT NOT NULL REFERENCES descriptions (id), author_id INT NOT NULL REFERENCES authors (id), PRIMARY KEY(description_id, author_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, description_id INT REFERENCES descriptions (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.regions ( id CHAR(2) NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, vendor_id INT REFERENCES Rose_db_object_private.vendors (id), region_id CHAR(2) REFERENCES Rose_db_object_private.regions (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, vendor_id INT REFERENCES Rose_db_object_private.vendors (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES Rose_db_object_private.products (id), region_id CHAR(2) NOT NULL REFERENCES Rose_db_object_private.regions (id) DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.descriptions ( id SERIAL NOT NULL PRIMARY KEY, text VARCHAR(255) NOT NULL, UNIQUE(text) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.authors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.nicknames ( id SERIAL NOT NULL PRIMARY KEY, nick VARCHAR(255) NOT NULL, author_id INT REFERENCES Rose_db_object_private.authors (id), UNIQUE(nick, author_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.description_author_map ( description_id INT NOT NULL REFERENCES Rose_db_object_private.descriptions (id), author_id INT NOT NULL REFERENCES Rose_db_object_private.authors (id), PRIMARY KEY(description_id, author_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, description_id INT REFERENCES Rose_db_object_private.descriptions (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.product_color_map ( product_id INT NOT NULL REFERENCES Rose_db_object_private.products (id), color_id INT NOT NULL REFERENCES Rose_db_object_private.colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; die "MySQL version too old" unless($db->database_version >= 4_000_000); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE descriptions CASCADE'); $dbh->do('DROP TABLE authors CASCADE'); $dbh->do('DROP TABLE nicknames CASCADE'); $dbh->do('DROP TABLE description_author_map CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE regions CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE regions ( id CHAR(2) NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF # MySQL will silently ignore the "ENGINE=InnoDB" part and create # a MyISAM table instead. MySQL is evil! Now we have to manually # check to make sure an InnoDB table was really created. my $db_name = $db->database; my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?"); $sth->execute('regions'); my $info = $sth->fetchrow_hashref; no warnings 'uninitialized'; unless(lc $info->{'Type'} eq 'innodb' || lc $info->{'Engine'} eq 'innodb') { die "Missing InnoDB support"; } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, vendor_id INT, region_id CHAR(2), INDEX(vendor_id), INDEX(region_id), FOREIGN KEY (vendor_id) REFERENCES vendors (id), FOREIGN KEY (region_id) REFERENCES regions (id), UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, vendor_id INT, INDEX(vendor_id), FOREIGN KEY (vendor_id) REFERENCES vendors (id), UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INT AUTO_INCREMENT PRIMARY KEY, product_id INT, region_id CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, INDEX(product_id), INDEX(region_id), FOREIGN KEY (product_id) REFERENCES products (id), FOREIGN KEY (region_id) REFERENCES regions (id), UNIQUE(product_id, region_id) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE descriptions ( id INT AUTO_INCREMENT PRIMARY KEY, text VARCHAR(255) NOT NULL, UNIQUE(text) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE authors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE nicknames ( id INT AUTO_INCREMENT PRIMARY KEY, nick VARCHAR(255) NOT NULL, author_id INT, INDEX(author_id), FOREIGN KEY (author_id) REFERENCES authors (id), UNIQUE(nick, author_id) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE description_author_map ( description_id INT NOT NULL, author_id INT NOT NULL, INDEX(description_id), INDEX(author_id), FOREIGN KEY (description_id) REFERENCES descriptions (id), FOREIGN KEY (author_id) REFERENCES authors (id), PRIMARY KEY(description_id, author_id) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, description_id INT, INDEX(description_id), FOREIGN KEY (description_id) REFERENCES descriptions (id), UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL, color_id INT NOT NULL, INDEX(product_id), INDEX(color_id), FOREIGN KEY (product_id) REFERENCES products (id), FOREIGN KEY (color_id) REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) ENGINE=InnoDB EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE description_author_map CASCADE'); $dbh->do('DROP TABLE nicknames CASCADE'); $dbh->do('DROP TABLE authors CASCADE'); $dbh->do('DROP TABLE descriptions CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE regions CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE regions ( id CHAR(2) NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, vendor_id INT REFERENCES vendors (id), region_id CHAR(2) REFERENCES regions (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, vendor_id INT REFERENCES vendors (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region_id CHAR(2) DEFAULT 'US' NOT NULL REFERENCES regions (id), price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE descriptions ( id SERIAL NOT NULL PRIMARY KEY, text VARCHAR(255) NOT NULL, UNIQUE(text) ) EOF $dbh->do(<<"EOF"); CREATE TABLE authors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE nicknames ( id SERIAL NOT NULL PRIMARY KEY, nick VARCHAR(255) NOT NULL, author_id INT REFERENCES authors (id), UNIQUE(nick, author_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE description_author_map ( description_id INT NOT NULL REFERENCES descriptions (id), author_id INT NOT NULL REFERENCES authors (id), PRIMARY KEY(description_id, author_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, description_id INT REFERENCES descriptions (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE descriptions'); $dbh->do('DROP TABLE authors'); $dbh->do('DROP TABLE nicknames'); $dbh->do('DROP TABLE description_author_map'); $dbh->do('DROP TABLE product_color_map'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); $dbh->do('DROP TABLE regions'); } $dbh->do(<<"EOF"); CREATE TABLE regions ( id CHAR(2) NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, vendor_id INT REFERENCES vendors (id), region_id CHAR(2) REFERENCES regions (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, vendor_id INT REFERENCES vendors (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INTEGER PRIMARY KEY AUTOINCREMENT, product_id INT NOT NULL REFERENCES products (id), region_id CHAR(2) NOT NULL REFERENCES regions (id) DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE descriptions ( id INTEGER PRIMARY KEY AUTOINCREMENT, text VARCHAR(255) NOT NULL, UNIQUE(text) ) EOF $dbh->do(<<"EOF"); CREATE TABLE authors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE nicknames ( id INTEGER PRIMARY KEY AUTOINCREMENT, nick VARCHAR(255) NOT NULL, author_id INT REFERENCES authors (id), UNIQUE(nick, author_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE description_author_map ( description_id INT NOT NULL REFERENCES descriptions (id), author_id INT NOT NULL REFERENCES authors (id), PRIMARY KEY(description_id, author_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, description_id INT REFERENCES descriptions (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } } END { if($Have{'pg'}) { my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE description_author_map CASCADE'); $dbh->do('DROP TABLE nicknames CASCADE'); $dbh->do('DROP TABLE authors CASCADE'); $dbh->do('DROP TABLE descriptions CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE regions CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.product_color_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.description_author_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.nicknames CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.authors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.descriptions CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.regions CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->disconnect; } if($Have{'mysql'}) { my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE description_author_map CASCADE'); $dbh->do('DROP TABLE nicknames CASCADE'); $dbh->do('DROP TABLE authors CASCADE'); $dbh->do('DROP TABLE descriptions CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE regions CASCADE'); $dbh->disconnect; } if($Have{'informix'}) { my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE description_author_map CASCADE'); $dbh->do('DROP TABLE nicknames CASCADE'); $dbh->do('DROP TABLE authors CASCADE'); $dbh->do('DROP TABLE descriptions CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE regions CASCADE'); $dbh->disconnect; } if($Have{'sqlite'}) { my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE descriptions'); $dbh->do('DROP TABLE authors'); $dbh->do('DROP TABLE nicknames'); $dbh->do('DROP TABLE description_author_map'); $dbh->do('DROP TABLE product_color_map'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); $dbh->do('DROP TABLE regions'); $dbh->disconnect; } } sub has_broken_order_by { my($db_type) = shift; no warnings 'uninitialized'; (my $version = $DBD::SQLite::VERSION) =~ s/_//g; if($db_type eq 'sqlite' && $version < 1.11) { return 1; } return 0; } sub cmp_sql { my($a, $b, $msg) = @_; for($a, $b) { s/\s+/ /g; s/^\s+//; s/\s+$//; s/^SELECT.*?FROM/SELECT * FROM/; s/\brose_db_object_private\.//g; } @_ = ($a, $b, $msg); goto &is; } Rose-DB-Object-0.810/t/inheritance.t000755 000765 000120 00000017712 11225465612 017144 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 55; use Scalar::Util qw(isweak refaddr); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); } eval { require Test::Memory::Cycle }; our $HAVE_TMC = $@ ? 0 : 1; our %HAVE; my $db_type = $HAVE{'sqlite'} ? 'sqlite' : (sort keys %HAVE)[0]; SKIP: { skip("No db available", 54) unless($db_type); package MyObject; use base 'Rose::DB::Object'; __PACKAGE__->meta->table('objects'); __PACKAGE__->meta->columns ( id => { type => 'int', primary_key => 1 }, start => { type => 'scalar' }, ); __PACKAGE__->meta->initialize; sub init_db { Rose::DB->new($db_type) } package MySubObject; use base 'MyObject'; __PACKAGE__->meta->column('id')->default(123); __PACKAGE__->meta->delete_column('start'); __PACKAGE__->meta->add_column(start => { type => 'datetime' }); __PACKAGE__->meta->initialize(replace_existing => 1); package MySubObject2; use base 'MyObject'; __PACKAGE__->meta->table('s2objs'); __PACKAGE__->meta->initialize(preserve_existing => 1); sub id { my($self) = shift; return $self->{'id'} = shift if(@_); return defined $self->{'id'} ? $self->{'id'} : 456; } package MySubObject3; use base 'MySubObject'; __PACKAGE__->meta->initialize(preserve_existing => 1); package main; if($HAVE_TMC) { Test::Memory::Cycle::memory_cycle_ok(MyObject->meta, "meta memory cycle ok MyObject - $db_type"); Test::Memory::Cycle::memory_cycle_ok(MySubObject->meta, "meta memory cycle ok MySubObject - $db_type"); Test::Memory::Cycle::memory_cycle_ok(MySubObject2->meta, "meta memory cycle ok MySubObject2 - $db_type"); } else { ok(1, 'Test::Memory::Cycle not installed'); ok(1, 'Test::Memory::Cycle not installed'); ok(1, 'Test::Memory::Cycle not installed'); } ok(MyObject->meta ne MySubObject->meta, "meta 1 - $db_type"); ok(MyObject->meta ne MySubObject2->meta, "meta 2 - $db_type"); ok(MySubObject->meta ne MySubObject2->meta, "meta 3 - $db_type"); ok(refaddr(MyObject->meta->column('id')) ne refaddr(MySubObject->meta->column('id')), "meta column 1 - $db_type"); ok(refaddr(MyObject->meta->column('id')) ne refaddr(MySubObject2->meta->column('id')), "meta column 2 - $db_type"); ok(refaddr(MySubObject->meta->column('id')) ne refaddr(MySubObject2->meta->column('id')), "meta column 3 - $db_type"); ok(isweak(MyObject->meta->column('id')->{'parent'}), "meta weakened 1 - $db_type"); ok(isweak(MySubObject->meta->column('id')->{'parent'}), "meta weakened 2 - $db_type"); ok(isweak(MySubObject2->meta->column('id')->{'parent'}), "meta weakened 3 - $db_type"); is(refaddr(MyObject->meta->column('id')->parent), refaddr(MyObject->meta), "meta parent 1 - $db_type"); is(refaddr(MySubObject->meta->column('id')->parent), refaddr(MySubObject->meta), "meta parent 2 - $db_type"); is(refaddr(MySubObject2->meta->column('id')->parent), refaddr(MySubObject2->meta), "meta parent 3 - $db_type"); my $o = MyObject->new; is(MyObject->meta->table, 'objects', "base class 1 - $db_type"); ok(!defined $o->id, "base class 2 - $db_type"); $o->start('1/2/2003'); is($o->start, '1/2/2003', "base class 3 - $db_type"); my $s = MySubObject->new; is(MyObject->meta->table, 'objects', "subclass 1.1 - $db_type"); is($s->id, 123, "subclass 1.2 - $db_type"); $s->start('1/2/2003'); is($s->start->strftime('%B'), 'January', "subclass 1.3 - $db_type"); my $t = MySubObject2->new; is(MySubObject2->meta->table, 's2objs', "subclass 2.1 - $db_type"); is($t->id, 456, "subclass 2.2 - $db_type"); $t->start('1/2/2003'); is($t->start, '1/2/2003', "subclass 2.3 - $db_type"); my $f = MySubObject3->new; is(MySubObject3->meta->table, 'objects', "subclass 3.1 - $db_type"); is($f->id, 123, "subclass 3.2 - $db_type"); $f->start('1/2/2003'); is($f->start->strftime('%B'), 'January', "subclass 3.3 - $db_type"); # Test again, but without this module $Scalar::Util::Clone::VERSION = undef; package My2Object; use base 'Rose::DB::Object'; __PACKAGE__->meta->table('objects'); __PACKAGE__->meta->columns ( id => { type => 'int', primary_key => 1 }, start => { type => 'scalar' }, ); __PACKAGE__->meta->initialize; sub init_db { Rose::DB->new($db_type) } package My2SubObject; use base 'My2Object'; __PACKAGE__->meta->column('id')->default(123); __PACKAGE__->meta->delete_column('start'); __PACKAGE__->meta->add_column(start => { type => 'datetime' }); __PACKAGE__->meta->initialize(replace_existing => 1); package My2SubObject2; use base 'My2Object'; __PACKAGE__->meta->table('s2objs'); __PACKAGE__->meta->initialize(preserve_existing => 1); sub id { my($self) = shift; return $self->{'id'} = shift if(@_); return defined $self->{'id'} ? $self->{'id'} : 456; } package My2SubObject3; use base 'My2SubObject'; __PACKAGE__->meta->initialize(preserve_existing => 1); package main; if($HAVE_TMC) { Test::Memory::Cycle::memory_cycle_ok(My2Object->meta, "meta memory cycle ok My2Object - $db_type"); Test::Memory::Cycle::memory_cycle_ok(My2SubObject->meta, "meta memory cycle ok My2SubObject - $db_type"); Test::Memory::Cycle::memory_cycle_ok(My2SubObject2->meta, "meta memory cycle ok My2SubObject2 - $db_type"); } else { ok(1, 'Test::Memory::Cycle not installed'); ok(1, 'Test::Memory::Cycle not installed'); ok(1, 'Test::Memory::Cycle not installed'); } ok(My2Object->meta ne My2SubObject->meta, "meta 1 - $db_type"); ok(My2Object->meta ne My2SubObject2->meta, "meta 2 - $db_type"); ok(My2SubObject->meta ne My2SubObject2->meta, "meta 3 - $db_type"); ok(refaddr(My2Object->meta->column('id')) ne refaddr(My2SubObject->meta->column('id')), "meta column 1 - $db_type"); ok(refaddr(My2Object->meta->column('id')) ne refaddr(My2SubObject2->meta->column('id')), "meta column 2 - $db_type"); ok(refaddr(My2SubObject->meta->column('id')) ne refaddr(My2SubObject2->meta->column('id')), "meta column 3 - $db_type"); ok(isweak(My2Object->meta->column('id')->{'parent'}), "meta weakened 1 - $db_type"); ok(isweak(My2SubObject->meta->column('id')->{'parent'}), "meta weakened 2 - $db_type"); ok(isweak(My2SubObject2->meta->column('id')->{'parent'}), "meta weakened 3 - $db_type"); is(refaddr(My2Object->meta->column('id')->parent), refaddr(My2Object->meta), "meta parent 1 - $db_type"); is(refaddr(My2SubObject->meta->column('id')->parent), refaddr(My2SubObject->meta), "meta parent 2 - $db_type"); is(refaddr(My2SubObject2->meta->column('id')->parent), refaddr(My2SubObject2->meta), "meta parent 3 - $db_type"); $o = My2Object->new; is(My2Object->meta->table, 'objects', "base class 1 - $db_type"); ok(!defined $o->id, "base class 2 - $db_type"); $o->start('1/2/2003'); is($o->start, '1/2/2003', "base class 3 - $db_type"); $s = My2SubObject->new; is(My2Object->meta->table, 'objects', "subclass 1.1 - $db_type"); is($s->id, 123, "subclass 1.2 - $db_type"); $s->start('1/2/2003'); is($s->start->strftime('%B'), 'January', "subclass 1.3 - $db_type"); $t = My2SubObject2->new; is(My2SubObject2->meta->table, 's2objs', "subclass 2.1 - $db_type"); is($t->id, 456, "subclass 2.2 - $db_type"); $t->start('1/2/2003'); is($t->start, '1/2/2003', "subclass 2.3 - $db_type"); $f = My2SubObject3->new; is(My2SubObject3->meta->table, 'objects', "subclass 3.1 - $db_type"); is($f->id, 123, "subclass 3.2 - $db_type"); $f->start('1/2/2003'); is($f->start->strftime('%B'), 'January', "subclass 3.3 - $db_type"); } BEGIN { our %HAVE; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $HAVE{'pg'} = 1; } # # MySQL # eval { $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $HAVE{'mysql'} = 1; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $HAVE{'sqlite'} = 1; } } Rose-DB-Object-0.810/t/lazy-columns.t000755 000765 000120 00000016763 12054157213 017311 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 80; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Manager'); use_ok('Rose::DateTime::Util'); } use Rose::DB::Object::Util qw(column_value_formatted_key); use Rose::DateTime::Util qw(parse_date); our(%Have, $Did_Setup); # # Setup # SETUP: { package MyObject; our @ISA = qw(Rose::DB::Object); MyObject->meta->table('Rose_db_object_test'); MyObject->meta->columns ( id => { primary_key => 1, not_null => 1 }, name => { type => 'varchar', length => 32 }, code => { type => 'varchar', length => 32, load_on_demand => 1, inflate => sub { uc $_[1] } }, start => { type => 'date', default => '12/24/1980', lazy => 1 }, ended => { type => 'date', default => '11/22/2003' }, date_created => { type => 'timestamp' }, ); } # # Tests # my @dbs = qw(mysql pg pg_with_schema informix sqlite); eval { require List::Util }; @dbs = List::Util::shuffle(@dbs) unless($@); # Good test orders: #@dbs = qw(pg mysql sqlite pg_with_schema informix); #print "# db type order: @dbs\n"; foreach my $db_type (@dbs) { SKIP: { # 15 skip("$db_type tests", 15) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB->default_type($db_type); if($Did_Setup++) { MyObject->meta->allow_inline_column_values(1); } else { eval { MyObject->meta->column('id')->lazy(1) }; ok($@, 'lazy pk 1'); MyObject->meta->primary_key_columns('code'); eval { MyObject->meta->initialize }; ok($@, 'lazy pk 2'); MyObject->meta->primary_key_columns('id'); MyObject->meta->initialize; } #MyObject->meta->init_with_db(Rose::DB->new); ## ## Run tests ## my $o = MyObject->new(name => 'John', code => 'abc', start => '10/20/2002', ended => '5/6/2004'); $o->save; $o = MyObject->new(id => $o->id); $o->load; ok(!defined $o->{'code'}, "lazy check 1 - $db_type"); ok(!defined $o->{'start'}, "lazy check 2 - $db_type"); is($o->code, 'ABC', "lazy load 1 - $db_type"); is($o->start->ymd, '2002-10-20', "lazy load 2 - $db_type"); is($o->ended->ymd, '2004-05-06', "load 1 - $db_type"); $o = MyObject->new(id => $o->id); $o->load; is($o->start->ymd, '2002-10-20', "lazy load 3 - $db_type"); $o->name('Foo'); $o->save; $o = MyObject->new(id => $o->id); $o->load; ok(!defined $o->{'code'}, "lazy check 3 - $db_type"); ok(!defined $o->{'start'}, "lazy check 4 - $db_type"); is($o->name, 'Foo', "load 2 - $db_type"); is($o->code, 'ABC', "lazy load 4 - $db_type"); is($o->start->ymd, '2002-10-20', "lazy load 5 - $db_type"); $o = MyObject->new(id => $o->id); $o->load(nonlazy => 1); is($o->{'code'}, 'abc', "nonlazy check 1 - $db_type"); my $key = column_value_formatted_key(MyObject->meta->column('start')->hash_key); ok(defined $o->{$key,$o->db->driver}, "nonlazy check 2 - $db_type"); $o->code(undef); $o->save; $o = MyObject->new(id => $o->id); $o->load; ok(!defined $o->{'code'}, "lazy check 5 - $db_type"); $o->code('def'); $o->save; $o = MyObject->new(id => $o->id); $o->load(nonlazy => 1); is($o->{'code'}, 'def', "nonlazy check 3 - $db_type"); #$DB::single = 1; #$Rose::DB::Object::Debug = 1; } SKIP: { skip("all db tests", 2) unless($Did_Setup); } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_test'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_test'); $dbh->do('DROP SCHEMA Rose_db_object_private'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); } $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, code VARCHAR(32), start DATE NOT NULL DEFAULT '1980-12-24', ended DATE, date_created TIMESTAMP ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.Rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, code VARCHAR(32), start DATE NOT NULL DEFAULT '1980-12-24', ended DATE, date_created TIMESTAMP ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_test'); } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_test ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, name VARCHAR(32) NOT NULL, code VARCHAR(32), start DATE NOT NULL DEFAULT '1980-12-24', ended DATE, date_created TIMESTAMP ) EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_test ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, code VARCHAR(32), start DATE DEFAULT '12/24/1980' NOT NULL, ended DATE, date_created DATETIME YEAR TO SECOND ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_test ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(32) NOT NULL, code VARCHAR(32), start DATE DEFAULT '1980-12-24' NOT NULL, ended DATE, date_created DATETIME ) EOF $dbh->disconnect; } } END { # Delete test table if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_test'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_test'); $dbh->do('DROP SCHEMA Rose_db_object_private'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_test'); $dbh->disconnect; } if($Have{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_test'); $dbh->disconnect; } if($Have{'sqlite'}) { # SQLite my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_test'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/leaks.t000644 000765 000120 00000037122 11653604702 015744 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Config; use Test::More; eval { require Test::Memory::Cycle }; plan(skip_all => 'Test::Memory::Cycle required for leak tests') if($@); use Rose::DB::Object::Manager; Test::More->import(tests => 5 * 2); BEGIN { require 't/test-lib.pl'; use Rose::DB::Object::Loader; use Rose::DB::Object::Manager; } our %Have; our @Tables = qw(vendors Products prices Colors product_color_map pk_test); our $Include_Tables = join('|', @Tables); # # Tests # my $i = 1; foreach my $db_type (qw(mysql pg pg_with_schema informix sqlite)) { SKIP: { skip("$db_type tests", 2) unless($Have{$db_type}); } next unless($Have{$db_type}); $i++; Rose::DB->default_type($db_type); Rose::DB::Object::Metadata->unregister_all_classes; my $class_prefix = ucfirst($db_type eq 'pg_with_schema' ? 'pgws' : $db_type); #$Rose::DB::Object::Metadata::Debug = 1; my $loader = Rose::DB::Object::Loader->new( db => Rose::DB->new, class_prefix => $class_prefix); my @classes = $loader->make_classes(include_tables => $Include_Tables); #foreach my $class (@classes) #{ # next unless($class->isa('Rose::DB::Object')); # print $class->meta->perl_class_definition, "\n"; #} my $product_class = $class_prefix . '::Product'; $product_class->new(id => 1, name => 'p1')->save; $product_class->new(id => 2, name => 'p2')->save; my $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => $product_class, with_objects => [ 'vendor', 'prices' ]); $iterator->next; Test::Memory::Cycle::memory_cycle_ok($iterator, "no memory cycles - $db_type"); # XXX: Confine lame memory tests to a known OS. # XXX: Should use a real rusage-ish module. if($^O eq 'darwin' && $Config{'osvers'} =~ /^9\./ && !$ENV{'AUTOMATED_TESTING'}) { my $first_size = `/bin/ps -orss= -p $$`; my $last_size = 0; use constant ITERATIONS => 100; my @leaked; foreach my $iterations (ITERATIONS, ITERATIONS * 2) { for(0 .. $iterations) { my $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => $product_class, with_objects => [ 'vendor', 'prices' ]); $iterator->next; next; my $size = `/bin/ps -orss= -p $$`; if($size > $last_size) { print "$size (+" . ($size - $last_size) . ")\n"; $last_size = $size; } } $last_size ||= `/bin/ps -orss= -p $$`; my $leaked = $last_size - $first_size; #$leaked && print "# Leaked ", ($leaked * 1024), ' bytes (', (($leaked * 1024) / $iterations), " bytes per iteration)\n"; push(@leaked, $leaked); } # There is a constant memory loss due to God-knows-what inside perl. # The thing to check is that it does not grow as iterations increase. is($leaked[0], $leaked[1], "no per-iteration leaks - $db_type"); } else { SKIP: { skip('leak tests that only run non-automated on darwin 9', 1) } } } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE pk_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.product_color_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); } $dbh->do(<<"EOF"); CREATE TABLE pk_test ( num INT NOT NULL, year VARCHAR(255) NOT NULL, name VARCHAR(255), PRIMARY KEY(num, year) ) EOF $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP NOT NULL DEFAULT NOW(), release_date TIMESTAMP, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.pk_test ( num INT NOT NULL, year VARCHAR(255) NOT NULL, name VARCHAR(255), PRIMARY KEY(num, year) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP NOT NULL DEFAULT NOW(), release_date TIMESTAMP, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; die "MySQL version too old" unless($db->database_version >= 4_000_000); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE pk_test CASCADE'); } # Foreign key stuff requires InnoDB support $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF # MySQL will silently ignore the "ENGINE=InnoDB" part and create # a MyISAM table instead. MySQL is evil! Now we have to manually # check to make sure an InnoDB table was really created. my $db_name = $db->database; my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?"); $sth->execute('vendors'); my $info = $sth->fetchrow_hashref; no warnings 'uninitialized'; unless(lc $info->{'Type'} eq 'innodb' || lc $info->{'Engine'} eq 'innodb') { die "Missing InnoDB support"; } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE pk_test ( num INT NOT NULL, year VARCHAR(255) NOT NULL, name VARCHAR(255), PRIMARY KEY(num, year) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT, status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP, release_date TIMESTAMP, UNIQUE(name), INDEX(vendor_id), FOREIGN KEY (vendor_id) REFERENCES vendors (id) ON DELETE NO ACTION ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INT AUTO_INCREMENT PRIMARY KEY, product_id INT NOT NULL, region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region), INDEX(product_id), FOREIGN KEY (product_id) REFERENCES products (id) ON UPDATE NO ACTION ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL, color_id INT NOT NULL, PRIMARY KEY(product_id, color_id), INDEX(color_id), INDEX(product_id), FOREIGN KEY (product_id) REFERENCES products (id) ON DELETE NO ACTION, FOREIGN KEY (color_id) REFERENCES colors (id) ON UPDATE NO ACTION ) ENGINE=InnoDB EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE pk_test CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE pk_test ( num INT NOT NULL, year VARCHAR(255) NOT NULL, name VARCHAR(255), PRIMARY KEY(num, year) ) EOF $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) DEFAULT 'inactive' NOT NULL CHECK(status IN ('inactive', 'active', 'defunct')), date_created DATETIME YEAR TO SECOND, release_date DATETIME YEAR TO SECOND, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_color_map'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); $dbh->do('DROP TABLE pk_test'); } $dbh->do(<<"EOF"); CREATE TABLE pk_test ( num INT NOT NULL, year VARCHAR(255) NOT NULL, name VARCHAR(255), PRIMARY KEY(num, year) ) EOF $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) DEFAULT 'inactive' NOT NULL CHECK(status IN ('inactive', 'active', 'defunct')), date_created DATETIME, release_date DATETIME, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( id INTEGER PRIMARY KEY AUTOINCREMENT, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) DEFAULT 0.00 NOT NULL, UNIQUE(product_id, region) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ) EOF $dbh->disconnect; } } END { # Delete test table if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE pk_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.product_color_map CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.colors CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.prices CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.products CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.vendors CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE pk_test CASCADE'); $dbh->disconnect; } if($Have{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->do('DROP TABLE pk_test CASCADE'); $dbh->disconnect; } if($Have{'sqlite'}) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_color_map'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE vendors'); $dbh->do('DROP TABLE pk_test'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/lib/000750 000765 000120 00000000000 12266514754 015224 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/make-modules.ext000755 000765 000120 00000007212 12102774764 017573 0ustar00johnadmin000000 000000 #!/usr/bin/perl use strict; use lib '../Rose-DB/lib'; use lib 'lib'; use lib 't/cg-lib'; require 't/test-lib.pl'; my $db_type = $ARGV[0] or die "Missing database type argument"; Rose::DB->default_type($db_type); my $class_prefix = 'My' . ucfirst($db_type); my $product_class = $class_prefix . '::Product'; my $product_manager_class = $product_class . '::Manager'; eval "require ${product_class}::Manager"; die "Could not load $product_class - $@" if($@); my $color_class = $class_prefix . '::Color'; my $color_manager_class = $color_class . '::Manager'; eval "require ${color_class}::Manager"; die "Could not load $color_class - $@" if($@); my $p = $product_class->new(id => 1, name => 'A'); $p->prices({ region => 'IS', price => 1.25 }, { region => 'DE', price => 4.25 }); $p->colors({ code => 'CC1', name => 'red' }, { code => 'CC2', name => 'green' }); $p->vendor({ name => 'V1' }); $p->save; $p = $product_class->new(id => $p->id)->load; my $ret = $p->vendor->name . '; ' . join(', ', map { $_->region . ': ' . $_->price } sort { $a->price <=> $b->price } $p->prices) . '; ' . join(', ', map { $_->name } sort { $a->name cmp $b->name } $p->colors) . '; '; my $c = $color_class->new(name => 'red')->load; $ret .= $c->name . ': ' . $c->code, '; '; print $ret, "\n"; my $v = $p->vendor; $p->delete(cascade => 1); $v->delete; $product_manager_class->delete_products(all => 1); $color_manager_class->delete_colors(all => 1); #My::Product->meta->auto_load_related_classes(0); #print My::Product->meta->perl_class_definition(braces => 'bsd', indent => 2); __END__ DROP TABLE product_colors CASCADE; DROP TABLE prices CASCADE; DROP TABLE products CASCADE; DROP TABLE colors CASCADE; DROP TABLE vendors CASCADE; CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) ); CREATE TABLE colors ( code CHAR(3) NOT NULL PRIMARY KEY, name VARCHAR(255) ); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255), vendor_id INT NOT NULL REFERENCES vendors (id) ); CREATE TABLE prices ( price_id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL ); CREATE TABLE product_colors ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), color_code CHAR(3) NOT NULL REFERENCES colors (code) ); INSERT INTO vendors (id, name) VALUES (1, 'V1'); INSERT INTO vendors (id, name) VALUES (2, 'V2'); INSERT INTO products (id, name, vendor_id) VALUES (1, 'A', 1); INSERT INTO products (id, name, vendor_id) VALUES (2, 'B', 2); INSERT INTO products (id, name, vendor_id) VALUES (3, 'C', 1); INSERT INTO prices (product_id, region, price) VALUES (1, 'US', 1.25); INSERT INTO prices (product_id, region, price) VALUES (1, 'DE', 4.25); INSERT INTO prices (product_id, region, price) VALUES (2, 'US', 5.55); INSERT INTO prices (product_id, region, price) VALUES (3, 'US', 5.78); INSERT INTO prices (product_id, region, price) VALUES (3, 'US', 9.99); INSERT INTO colors (code, name) VALUES ('CC1', 'red'); INSERT INTO colors (code, name) VALUES ('CC2', 'green'); INSERT INTO colors (code, name) VALUES ('CC3', 'blue'); INSERT INTO colors (code, name) VALUES ('CC4', 'pink'); INSERT INTO product_colors (product_id, color_code) VALUES (1, 'CC1'); INSERT INTO product_colors (product_id, color_code) VALUES (1, 'CC2'); INSERT INTO product_colors (product_id, color_code) VALUES (2, 'CC4'); INSERT INTO product_colors (product_id, color_code) VALUES (3, 'CC2'); INSERT INTO product_colors (product_id, color_code) VALUES (3, 'CC3'); Rose-DB-Object-0.810/t/make-modules.t000755 000765 000120 00000034305 12103007746 017227 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More(); my $Lib_Dir = 't/cg-lib'; unless(-d $Lib_Dir) { mkdir($Lib_Dir); } if(-d $Lib_Dir) { Test::More->import(tests => 2 + (4 * 4)); } else { Test::More->import(skip_all => "Could not mkdir($Lib_Dir) - $!"); } require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Loader'); my $Include_Tables = '^(?:' . join('|', qw(product_colors prices products colors vendors)) . ')$'; $Include_Tables = qr($Include_Tables); my %Column_Defs = ( pg => { id => q(id => { type => 'serial', not_null => 1 },), vendor_id => q(vendor_id => { type => 'integer', not_null => 1 },), }, mysql => { id => q(id => { type => 'serial', not_null => 1 },), vendor_id => q(vendor_id => { type => 'integer', default => '', not_null => 1 },), }, sqlite => { id => q(id => { type => 'serial' },), vendor_id => q(vendor_id => { type => 'integer', not_null => 1 },), }, informix => { id => q(id => { type => 'serial', not_null => 1 },), vendor_id => q(vendor_id => { type => 'integer', not_null => 1 },), }, ); use Config; my $Perl = $^X; if($^O ne 'VMS') { $Perl .= $Config{'_exe'} unless($Perl =~ /$Config{'_exe'}$/i); } # # Tests # foreach my $db_type (qw(pg mysql informix sqlite)) { unless(have_db($db_type)) { SKIP: { skip("$db_type tests", 4) } next; } Rose::DB::Object::Metadata->unregister_all_classes; Rose::DB->default_type($db_type); if($db_type eq 'mysql') { my $serial = Rose::DB->new->dbh->{'Driver'}{'Version'} >= 4.002 ? 'serial' : 'integer'; $Column_Defs{'mysql'}{'id'} = qq(id => { type => '$serial', not_null => 1 },); } my $class_prefix = 'My' . ucfirst($db_type); my $loader = Rose::DB::Object::Loader->new( db_class => 'Rose::DB', class_prefix => $class_prefix, module_preamble => "# My Preamble\n", module_postamble => 'This will be hidden', include_tables => $Include_Tables); $loader->make_modules(module_dir => $Lib_Dir, braces => 'bsd', indent => 2, module_postamble => sub { no warnings 'uninitialized'; "# My Postamble for " . $_[0]->class . " ($_[1])\n"; }); my $mylsq_5_51 = ($db_type eq 'mysql' && Rose::DB->new->database_version >= 5_000_051) ? 1 : 0; # XXX: Lame if(slurp("$Lib_Dir/$class_prefix/Product.pm") !~ /default => '', /) # $mylsq_5_51 { $Column_Defs{$db_type}{'vendor_id'} =~ s/default => '', //; } my $unique_keys; no warnings 'uninitialized'; my($v1, $v2, $v3) = split(/\./, $DBD::Pg::VERSION); if($db_type eq 'pg' && $v1 >= 2 && $v2 >= 19) { $unique_keys = qq([ 'name' ],\n [ 'name', 'vendor_id' ],); } else { $unique_keys = qq([ 'name', 'vendor_id' ],\n [ 'name' ],); } is(slurp("$Lib_Dir/$class_prefix/Product.pm"), <<"EOF", "Product 1 - $db_type"); # My Preamble package ${class_prefix}::Product; use strict; use base qw(${class_prefix}::DB::Object::AutoBaseNNN); __PACKAGE__->meta->setup ( table => 'products', columns => [ $Column_Defs{$db_type}{'id'} name => { type => 'varchar', length => 255 }, $Column_Defs{$db_type}{'vendor_id'} ], primary_key_columns => [ 'id' ], unique_keys => [ $unique_keys ], foreign_keys => [ vendor => { class => '${class_prefix}::Vendor', key_columns => { vendor_id => 'id' }, }, ], relationships => [ colors => { map_class => '${class_prefix}::ProductColor', map_from => 'product', map_to => 'color', type => 'many to many', }, prices => { class => '${class_prefix}::Price', column_map => { id => 'product_id' }, type => 'one to many', }, ], ); 1; # My Postamble for ${class_prefix}::Product () EOF is(slurp("$Lib_Dir/$class_prefix/Product/Manager.pm"), <<"EOF", "Product Manager 1 - $db_type"); # My Preamble package ${class_prefix}::Product::Manager; use strict; use base qw(Rose::DB::Object::Manager); use ${class_prefix}::Product; sub object_class { '${class_prefix}::Product' } __PACKAGE__->make_manager_methods('products'); 1; # My Postamble for ${class_prefix}::Product (${class_prefix}::Product::Manager) EOF is(slurp("$Lib_Dir/$class_prefix/Color.pm"), <<"EOF", "Color 1 - $db_type"); # My Preamble package ${class_prefix}::Color; use strict; use base qw(${class_prefix}::DB::Object::AutoBaseNNN); __PACKAGE__->meta->setup ( table => 'colors', columns => [ code => { type => 'character', length => 3, not_null => 1 }, name => { type => 'varchar', length => 255 }, ], primary_key_columns => [ 'code' ], unique_key => [ 'name' ], relationships => [ products => { map_class => '${class_prefix}::ProductColor', map_from => 'color', map_to => 'product', type => 'many to many', }, ], ); 1; # My Postamble for ${class_prefix}::Color () EOF unshift(@INC, $Lib_Dir); # Test actual code by running external script with db type arg my($ok, $script_fh); # Perl 5.8.x and later support the FILEHANDLE,MODE,EXPR,LIST form of # open, but not (apparently) on Windows if($Config{'version'} =~ /^5\.([89]|1\d)\./ && $^O !~ /Win32/i) { $ok = open($script_fh, '-|', $Perl, 't/make-modules.ext', $db_type); } else { $ok = open($script_fh, "$Perl t/make-modules.ext $db_type |"); } if($ok) { chomp(my $line = <$script_fh>); close($script_fh); is($line, 'V1; IS: 1.25, DE: 4.25; green, red; red: CC1', "external test - $db_type"); } else { ok(0, "Failed to open external script for $db_type - $!"); } shift(@INC); } BEGIN { require 't/test-lib.pl'; # # PostgreSQL # if(have_db('pg_admin')) { my $dbh = get_dbh('pg_admin'); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( code CHAR(3) NOT NULL PRIMARY KEY, name VARCHAR(255), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255), vendor_id INT NOT NULL REFERENCES vendors (id), UNIQUE(name, vendor_id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( price_id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_colors ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), color_code CHAR(3) NOT NULL REFERENCES colors (code) ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = get_db('mysql_admin'); my $dbh = $db->retain_dbh or die Rose::DB->error; my $db_version = $db->database_version; die "MySQL version too old" unless($db_version >= 4_000_000); CLEAR: { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } # Foreign key stuff requires InnoDB support $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) ) ENGINE=InnoDB EOF # MySQL will silently ignore the "ENGINE=InnoDB" part and create # a MyISAM table instead. MySQL is evil! Now we have to manually # check to make sure an InnoDB table was really created. my $db_name = $db->database; my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?"); $sth->execute('vendors'); my $info = $sth->fetchrow_hashref; no warnings 'uninitialized'; unless(lc $info->{'Type'} eq 'innodb' || lc $info->{'Engine'} eq 'innodb') { die "Missing InnoDB support"; } }; if($@) { have_db(mysql_admin => 0); have_db(mysql => 0); } if(have_db('mysql_admin')) { my $dbh = get_dbh('mysql_admin'); $dbh->do(<<"EOF"); CREATE TABLE colors ( code CHAR(3) NOT NULL PRIMARY KEY, name VARCHAR(255), UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255), vendor_id INT NOT NULL, UNIQUE(name, vendor_id), UNIQUE(name), INDEX(vendor_id), FOREIGN KEY (vendor_id) REFERENCES vendors (id) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( price_id INT AUTO_INCREMENT PRIMARY KEY, product_id INT NOT NULL, region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL, INDEX(product_id), FOREIGN KEY (product_id) REFERENCES products (id) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE product_colors ( id INT AUTO_INCREMENT PRIMARY KEY, product_id INT NOT NULL, color_code CHAR(3) NOT NULL, INDEX(product_id), INDEX(color_code), FOREIGN KEY (product_id) REFERENCES products (id), FOREIGN KEY (color_code) REFERENCES colors (code) ) ENGINE=InnoDB EOF $dbh->disconnect; } # # Informix # if(have_db('informix_admin')) { my $dbh = get_dbh('informix_admin'); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( code CHAR(3) NOT NULL PRIMARY KEY, name VARCHAR(255), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255), vendor_id INT NOT NULL REFERENCES vendors (id), UNIQUE(name, vendor_id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( price_id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_colors ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), color_code CHAR(3) NOT NULL REFERENCES colors (code) ) EOF $dbh->disconnect; } # # SQLite # if(have_db('sqlite_admin')) { my $dbh = get_dbh('sqlite_admin'); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( code CHAR(3) NOT NULL PRIMARY KEY, name VARCHAR(255), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255), vendor_id INT NOT NULL REFERENCES vendors (id), UNIQUE(name, vendor_id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( price_id INTEGER PRIMARY KEY AUTOINCREMENT, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_colors ( id INTEGER PRIMARY KEY AUTOINCREMENT, product_id INT NOT NULL REFERENCES products (id), color_code CHAR(3) NOT NULL REFERENCES colors (code) ) EOF $dbh->disconnect; } } sub slurp { my($path) = shift; return undef unless(-e $path); open(my $fh, $path) or die "Could not open '$path' - $!"; my $data = do { local $/; <$fh> }; # Normalize auto-numbered base classes for($data) { s/::DB::Object::AutoBase\d+/::DB::Object::AutoBaseNNN/g; # MySQL 4.1.2 apparently defaults INTEGER NOT NULL columns to 0 s/default => '0',/default => '',/; } return $data; } END { eval 'require File::Path'; # Delete the lib dir unless($@) { File::Path::rmtree($Lib_Dir, 0, 1); } # Delete test tables if(have_db('pg_admin')) { my $dbh = get_dbh('pg_admin'); $dbh->do('DROP TABLE product_colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if(have_db('mysql_admin')) { my $dbh = get_dbh('mysql_admin'); $dbh->do('DROP TABLE product_colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if(have_db('informix_admin')) { my $dbh = get_dbh('informix_admin'); $dbh->do('DROP TABLE product_colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if(have_db('sqlite_admin')) { my $dbh = get_dbh('sqlite_admin'); $dbh->do('DROP TABLE product_colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE vendors'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/makemethods-db.t000755 000765 000120 00000044762 11225465612 017544 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 51; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Manager'); use_ok('Rose::DB::Object::MakeMethods::Generic'); } our($HAVE_PG, $HAVE_MYSQL, $HAVE_INFORMIX, $HAVE_SQLITE); # # PostgreSQL # SKIP: foreach my $db_type (qw(pg)) #pg_with_schema { skip("PostgreSQL tests", 12) unless($HAVE_PG); Rose::DB->default_type($db_type); my $o = MyPgObject->new(id => 1, name => 'John', fkone => 1, fk2 => 2, fk3 => 3); ok($o->save, "object save() 1 - $db_type"); my $fo = MyPgOtherObject->new(id => 1, name => 'Foo', k1 => 1, ktwo => 2, k3 => 3); ok($fo->save, "object save() 2 - $db_type"); $fo = MyPgOtherObject->new(id => 2, name => 'Bar', k1 => 1, ktwo => 2, k3 => 3); ok($fo->save, "object save() 3 - $db_type"); $fo = MyPgOtherObject->new(id => 3, name => 'bar 2', k1 => 1, ktwo => 2, k3 => 3); ok($fo->save, "object save() 4 - $db_type"); $fo = MyPgOtherObject->new(id => 4, name => 'Baz', k1 => 2, ktwo => 3, k3 => 4); ok($fo->save, "object save() 5 - $db_type"); my $objs = $o->other_objs; ok($objs && ref $objs eq 'ARRAY' && @$objs == 3, "get objects 1 - $db_type"); is($objs->[0]->id, 2, "get objects 2 - $db_type"); is($objs->[1]->id, 3, "get objects 3 - $db_type"); is($objs->[2]->id, 1, "get objects 4 - $db_type"); $o->fkone(2); $o->fk2(3); $o->fk3(4); $o->other_objs(undef); $objs = $o->other_objs; ok($objs && ref $objs eq 'ARRAY' && @$objs == 1, "get objects 5 - $db_type"); is($objs->[0]->id, 4, "get objects 6 - $db_type"); $o->fkone(7); $o->fk2(8); $o->fk3(9); $o->other_objs(undef); $objs = $o->other_objs; ok($objs && ref $objs eq 'ARRAY' && @$objs == 0, "get objects 7 - $db_type"); } # # MySQL # SKIP: foreach my $db_type ('mysql') { skip("MySQL tests", 12) unless($HAVE_MYSQL); Rose::DB->default_type($db_type); my $o = MyMySQLObject->new(id => 1, name => 'John', fkone => 1, fk2 => 2, fk3 => 3); ok($o->save, "object save() 1 - $db_type"); my $fo = MyMySQLOtherObject->new(id => 1, name => 'Foo', k1 => 1, ktwo => 2, k3 => 3); ok($fo->save, "object save() 2 - $db_type"); $fo = MyMySQLOtherObject->new(id => 2, name => 'Bar', k1 => 1, ktwo => 2, k3 => 3); ok($fo->save, "object save() 3 - $db_type"); $fo = MyMySQLOtherObject->new(id => 3, name => 'bar 2', k1 => 1, ktwo => 2, k3 => 3); ok($fo->save, "object save() 4 - $db_type"); $fo = MyMySQLOtherObject->new(id => 4, name => 'Baz', k1 => 2, ktwo => 3, k3 => 4); ok($fo->save, "object save() 5 - $db_type"); my $objs = $o->other_objs; ok($objs && ref $objs eq 'ARRAY' && @$objs == 3, "get objects 1 - $db_type"); is($objs->[0]->id, 2, "get objects 2 - $db_type"); is($objs->[1]->id, 3, "get objects 3 - $db_type"); is($objs->[2]->id, 1, "get objects 4 - $db_type"); $o->fkone(2); $o->fk2(3); $o->fk3(4); $o->other_objs(undef); $objs = $o->other_objs; ok($objs && ref $objs eq 'ARRAY' && @$objs == 1, "get objects 5 - $db_type"); is($objs->[0]->id, 4, "get objects 6 - $db_type"); $o->fkone(7); $o->fk2(8); $o->fk3(9); $o->other_objs(undef); $objs = $o->other_objs; ok($objs && ref $objs eq 'ARRAY' && @$objs == 0, "get objects 7 - $db_type"); } # # Informix # SKIP: foreach my $db_type (qw(informix)) { skip("Informix tests", 12) unless($HAVE_INFORMIX); Rose::DB->default_type($db_type); my $o = MyInformixObject->new(id => 1, name => 'John', fkone => 1, fk2 => 2, fk3 => 3); ok($o->save, "object save() 1 - $db_type"); my $fo = MyInformixOtherObject->new(id => 1, name => 'Foo', k1 => 1, ktwo => 2, k3 => 3); ok($fo->save, "object save() 2 - $db_type"); $fo = MyInformixOtherObject->new(id => 2, name => 'Bar', k1 => 1, ktwo => 2, k3 => 3); ok($fo->save, "object save() 3 - $db_type"); $fo = MyInformixOtherObject->new(id => 3, name => 'bar 2', k1 => 1, ktwo => 2, k3 => 3); ok($fo->save, "object save() 4 - $db_type"); $fo = MyInformixOtherObject->new(id => 4, name => 'Baz', k1 => 2, ktwo => 3, k3 => 4); ok($fo->save, "object save() 5 - $db_type"); my $objs = $o->other_objs; ok($objs && ref $objs eq 'ARRAY' && @$objs == 3, "get objects 1 - $db_type"); is($objs->[0]->id, 2, "get objects 2 - $db_type"); is($objs->[1]->id, 3, "get objects 3 - $db_type"); is($objs->[2]->id, 1, "get objects 4 - $db_type"); $o->fkone(2); $o->fk2(3); $o->fk3(4); $o->other_objs(undef); $objs = $o->other_objs; ok($objs && ref $objs eq 'ARRAY' && @$objs == 1, "get objects 5 - $db_type"); is($objs->[0]->id, 4, "get objects 6 - $db_type"); $o->fkone(7); $o->fk2(8); $o->fk3(9); $o->other_objs(undef); $objs = $o->other_objs; ok($objs && ref $objs eq 'ARRAY' && @$objs == 0, "get objects 7 - $db_type"); } # # SQLite # SKIP: foreach my $db_type (qw(sqlite)) { skip("SQLite tests", 12) unless($HAVE_SQLITE); Rose::DB->default_type($db_type); my $o = MySQLiteObject->new(id => 1, name => 'John', fkone => 1, fk2 => 2, fk3 => 3); ok($o->save, "object save() 1 - $db_type"); my $fo = MySQLiteOtherObject->new(id => 1, name => 'Foo', k1 => 1, ktwo => 2, k3 => 3); ok($fo->save, "object save() 2 - $db_type"); $fo = MySQLiteOtherObject->new(id => 2, name => 'Bar', k1 => 1, ktwo => 2, k3 => 3); ok($fo->save, "object save() 3 - $db_type"); $fo = MySQLiteOtherObject->new(id => 3, name => 'bar 2', k1 => 1, ktwo => 2, k3 => 3); ok($fo->save, "object save() 4 - $db_type"); $fo = MySQLiteOtherObject->new(id => 4, name => 'Baz', k1 => 2, ktwo => 3, k3 => 4); ok($fo->save, "object save() 5 - $db_type"); my $objs = $o->other_objs; ok($objs && ref $objs eq 'ARRAY' && @$objs == 3, "get objects 1 - $db_type"); is($objs->[0]->id, 2, "get objects 2 - $db_type"); is($objs->[1]->id, 3, "get objects 3 - $db_type"); is($objs->[2]->id, 1, "get objects 4 - $db_type"); $o->fkone(2); $o->fk2(3); $o->fk3(4); $o->other_objs(undef); $objs = $o->other_objs; ok($objs && ref $objs eq 'ARRAY' && @$objs == 1, "get objects 5 - $db_type"); is($objs->[0]->id, 4, "get objects 6 - $db_type"); $o->fkone(7); $o->fk2(8); $o->fk3(9); $o->other_objs(undef); $objs = $o->other_objs; ok($objs && ref $objs eq 'ARRAY' && @$objs == 0, "get objects 7 - $db_type"); } BEGIN { # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_PG = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_other'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other ( id INT NOT NULL PRIMARY KEY, k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32) ) EOF # Create test foreign subclass package MyPgOtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } MyPgOtherObject->meta->table('rose_db_object_other'); MyPgOtherObject->meta->columns ( id => { primary_key => 1 }, name => { type => 'varchar'}, k1 => { type => 'int' }, k2 => { type => 'int' }, k3 => { type => 'int' }, ); MyPgOtherObject->meta->alias_column(k2 => 'ktwo'); MyPgOtherObject->meta->initialize; $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, fk1 INT, fk2 INT, fk3 INT ) EOF $dbh->disconnect; # Create test subclass package MyPgObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } MyPgObject->meta->table('rose_db_object_test'); MyPgObject->meta->columns ( 'name', id => { primary_key => 1 }, fk1 => { type => 'int' }, fk2 => { type => 'int' }, fk3 => { type => 'int' }, ); MyPgObject->meta->alias_column(fk1 => 'fkone'); MyPgObject->meta->initialize; Rose::DB::Object::MakeMethods::Generic->import ( objects_by_key => [ other_objs => { class => 'MyPgOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, manager_args => { sort_by => 'LOWER(name)' }, query_args => [ name => { ne => 'foo' } ], }, ] ); } # # MySQL # eval { $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_MYSQL = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_other'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other ( id INT NOT NULL PRIMARY KEY, k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32) ) EOF # Create test foreign subclass package MyMySQLOtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } MyMySQLOtherObject->meta->table('rose_db_object_other'); MyMySQLOtherObject->meta->columns ( id => { primary_key => 1 }, name => { type => 'varchar'}, k1 => { type => 'int' }, k2 => { type => 'int' }, k3 => { type => 'int' }, ); MyMySQLOtherObject->meta->alias_column(k2 => 'ktwo'); MyMySQLOtherObject->meta->initialize; $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, fk1 INT, fk2 INT, fk3 INT ) EOF $dbh->disconnect; # Create test subclass package MyMySQLObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('mysql') } MyMySQLObject->meta->table('rose_db_object_test'); MyMySQLObject->meta->columns ( 'name', id => { primary_key => 1 }, fk1 => { type => 'int' }, fk2 => { type => 'int' }, fk3 => { type => 'int' }, ); MyMySQLObject->meta->alias_column(fk1 => 'fkone'); MyMySQLObject->meta->initialize; Rose::DB::Object::MakeMethods::Generic->import ( objects_by_key => [ other_objs => { class => 'MyMySQLOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, manager_args => { sort_by => 'LOWER(name)' }, }, ] ); } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_INFORMIX = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_other'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other ( id INT NOT NULL PRIMARY KEY, k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32) ) EOF # Create test foreign subclass package MyInformixOtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('informix') } MyInformixOtherObject->meta->table('rose_db_object_other'); MyInformixOtherObject->meta->columns ( id => { primary_key => 1 }, name => { type => 'varchar'}, k1 => { type => 'int' }, k2 => { type => 'int' }, k3 => { type => 'int' }, ); MyInformixOtherObject->meta->alias_column(k2 => 'ktwo'); MyInformixOtherObject->meta->initialize; $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, fk1 INT, fk2 INT, fk3 INT ) EOF $dbh->disconnect; # Create test subclass package MyInformixObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('informix') } MyInformixObject->meta->table('rose_db_object_test'); MyInformixObject->meta->columns ( 'name', id => { primary_key => 1 }, fk1 => { type => 'int' }, fk2 => { type => 'int' }, fk3 => { type => 'int' }, ); MyInformixObject->meta->alias_column(fk1 => 'fkone'); MyInformixObject->meta->initialize; Rose::DB::Object::MakeMethods::Generic->import ( objects_by_key => [ other_objs => { class => 'MyInformixOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, manager_args => { sort_by => 'LOWER(name)' }, }, ] ); } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_SQLITE = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_other'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_other ( id INT NOT NULL PRIMARY KEY, k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32) ) EOF # Create test foreign subclass package MySQLiteOtherObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MySQLiteOtherObject->meta->table('rose_db_object_other'); MySQLiteOtherObject->meta->columns ( id => { primary_key => 1 }, name => { type => 'varchar'}, k1 => { type => 'int' }, k2 => { type => 'int' }, k3 => { type => 'int' }, ); MySQLiteOtherObject->meta->alias_column(k2 => 'ktwo'); MySQLiteOtherObject->meta->initialize; $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INT NOT NULL PRIMARY KEY, name VARCHAR(32) NOT NULL, fk1 INT, fk2 INT, fk3 INT ) EOF $dbh->disconnect; # Create test subclass package MySQLiteObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } MySQLiteObject->meta->table('rose_db_object_test'); MySQLiteObject->meta->columns ( 'name', id => { primary_key => 1 }, fk1 => { type => 'int' }, fk2 => { type => 'int' }, fk3 => { type => 'int' }, ); MySQLiteObject->meta->alias_column(fk1 => 'fkone'); MySQLiteObject->meta->initialize; Rose::DB::Object::MakeMethods::Generic->import ( objects_by_key => [ other_objs => { class => 'MySQLiteOtherObject', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, manager_args => { sort_by => 'LOWER(name)' }, }, ] ); } } END { # Delete test tables if($HAVE_PG) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->disconnect; } if($HAVE_MYSQL) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->disconnect; } if($HAVE_INFORMIX) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->disconnect; } if($HAVE_SQLITE) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->do('DROP TABLE rose_db_object_other'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/makemethods.t000755 000765 000120 00000034041 11113677033 017144 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 125; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::MakeMethods::Generic'); use_ok('Rose::DB::Object::MakeMethods::Pg'); } use Rose::DB::Object::Constants qw(STATE_SAVING); my $p = Person->new() || ok(0); ok(ref $p && $p->isa('Person'), 'Construct object (no init)'); # # scalar # is($p->scalar('foo'), 'foo', 'scalar get_set 1'); is($p->scalar, 'foo', 'scalar get_set 2'); is($p->set_scalar('bar'), 'bar', 'scalar set 1'); eval { $p->set_scalar() }; ok($@, 'scalar set 2'); is($p->get_scalar, 'bar', 'scalar get'); # # character # is($p->character('booga'), 'boog', 'character get_set 1'); is($p->character, 'boog', 'character get_set 2'); eval { $p->character_die('booga') }; ok($@, 'character_die get_set 1'); is($p->set_character('woo'), 'woo ', 'character set 1'); eval { $p->set_character() }; ok($@, 'character set 2'); is($p->get_character, 'woo ', 'character get'); # # varchar # is($p->varchar('booga'), 'boog', 'varchar get_set 1'); is($p->varchar, 'boog', 'varchar get_set 2'); eval { $p->varchar_die('booga') }; ok($@, 'varchar_die get_set 1'); is($p->set_varchar('woo'), 'woo', 'varchar set 1'); eval { $p->set_varchar() }; ok($@, 'varchar set 2'); is($p->get_varchar, 'woo', 'varchar get'); # # These tests require a connected Rose::DB # our $db_type; eval { require Rose::DB; foreach my $type (qw(pg mysql informix)) { Rose::DB->default_type($type); my $db = Rose::DB->new(); $db->raise_error(0); $db->print_error(0); my $ret; eval { $ret = $db->connect }; if($ret && !$@) { $db_type = $type; last; } } die unless(defined $db_type); }; SKIP: { skip("Can't connect to db", 99) if($@); # # boolean # is($p->boolean('true'), 1, 'boolean get_set 1'); is($p->boolean, 1, 'boolean get_set 2'); is($p->set_boolean('F'), 0, 'boolean set 1'); eval { $p->set_boolean() }; ok($@, 'boolean set 2'); is($p->get_boolean, 0, 'boolean get'); $p = Person->new(sql_is_happy => 1); ok(ref $p && $p->isa('Person'), 'boolean 1'); is($p->sql_is_happy, 1, 'boolean 2'); foreach my $val (qw(t true True TRUE T y Y yes Yes YES 1 1.0 1.00)) { eval { $p->sql_is_happy($val) }; ok(!$@ && $p->sql_is_happy, "boolean true '$val'"); } foreach my $val (qw(f false False FALSE F n N no No NO 0 0.0 0.00)) { eval { $p->sql_is_happy($val) }; ok(!$@ && !$p->sql_is_happy, "boolean false '$val'"); } # # date # is($p->date('12/24/1980')->ymd, '1980-12-24', 'date get_set 1'); is($p->date->ymd, '1980-12-24', 'date get_set 2'); is($p->set_date('1980-12-25')->ymd, '1980-12-25', 'date set 1'); eval { $p->set_date() }; ok($@, 'date set 2'); is($p->get_date->ymd, '1980-12-25', 'date get'); $p = Person->new(sql_date_birthday => '12/24/1980 1:00'); ok(ref $p && $p->isa('Person'), 'date 1'); is($p->sql_date_birthday->ymd, '1980-12-24', 'date 2'); is($p->sql_date_birthday(truncate => 'month')->ymd, '1980-12-01', 'date truncate'); is($p->sql_date_birthday(format => '%B'), 'December', 'date format'); $p->sql_date_birthday('12/24/1980 1:00:01'); is($p->sql_date_birthday->ymd, '1980-12-24', 'date 4'); is($p->sql_date_birthday_def->ymd, '2002-01-01', 'date 5'); $p->sql_date_birthday('now'); if($db_type eq 'pg') { is($p->sql_date_birthday, 'now', 'date now'); } else { ok($p->sql_date_birthday =~ /^2/, 'date now'); } $p->sql_date_birthday('infinity'); is($p->sql_date_birthday(format => ''), 'infinity', 'date infinity'); $p->sql_date_birthday('-infinity'); is($p->sql_date_birthday(format => ''), '-infinity', 'date -infinity'); eval { $p->sql_date_birthday('asdf') }; ok($@, 'Invalid date'); # # datetime # is($p->datetime('12/24/1980 12:34:56')->strftime('%Y-%m-%d %H:%M:%S'), '1980-12-24 12:34:56', 'datetime get_set 1'); is($p->datetime->strftime('%Y-%m-%d %H:%M:%S'), '1980-12-24 12:34:56', 'datetime get_set 2'); is($p->set_datetime('1980-12-25 12:30:50')->strftime('%Y-%m-%d %H:%M:%S'), '1980-12-25 12:30:50', 'datetime set 1'); eval { $p->set_datetime() }; ok($@, 'datetime set 2'); is($p->get_datetime->strftime('%Y-%m-%d %H:%M:%S'), '1980-12-25 12:30:50', 'datetime get'); $p = Person->new(sql_datetime_birthday => '12/24/1980 1:00'); ok(ref $p && $p->isa('Person'), 'datetime 1'); is($p->sql_datetime_birthday->strftime('%Y-%m-%d %H:%M:%S'), '1980-12-24 01:00:00', 'datetime 2'); is($p->sql_datetime_birthday(truncate => 'month')->strftime('%Y-%m-%d %H:%M:%S'), '1980-12-01 00:00:00', 'datetime truncate'); $p->sql_datetime_birthday('12/24/1980 1:00:01'); is($p->sql_datetime_birthday->strftime('%Y-%m-%d %H:%M:%S'), '1980-12-24 01:00:01', 'datetime 4'); is($p->sql_datetime_birthday_def->strftime('%Y-%m-%d %H:%M:%S'), '2002-01-02 00:00:00', 'datetime 5'); eval { $p->sql_datetime_birthday('asdf') }; ok($@, 'Invalid datetime'); # # timestamp # is($p->timestamp('12/24/1980 12:34:56')->strftime('%Y-%m-%d %H:%M:%S'), '1980-12-24 12:34:56', 'timestamp get_set 1'); is($p->timestamp->strftime('%Y-%m-%d %H:%M:%S'), '1980-12-24 12:34:56', 'timestamp get_set 2'); is($p->set_timestamp('1980-12-25 12:30:50')->strftime('%Y-%m-%d %H:%M:%S'), '1980-12-25 12:30:50', 'timestamp set 1'); eval { $p->set_timestamp() }; ok($@, 'timestamp set 2'); is($p->get_timestamp->strftime('%Y-%m-%d %H:%M:%S'), '1980-12-25 12:30:50', 'timestamp get'); $p = Person->new(sql_timestamp_birthday => '12/24/1980 1:00'); ok(ref $p && $p->isa('Person'), 'timestamp 1'); is($p->sql_timestamp_birthday->strftime('%Y-%m-%d %H:%M:%S'), '1980-12-24 01:00:00', 'timestamp 2'); is($p->sql_timestamp_birthday(truncate => 'month')->strftime('%Y-%m-%d %H:%M:%S'), '1980-12-01 00:00:00', 'timestamp truncate'); $p->sql_timestamp_birthday('12/24/1980 1:00:01'); is($p->sql_timestamp_birthday->strftime('%Y-%m-%d %H:%M:%S'), '1980-12-24 01:00:01', 'timestamp 4'); is($p->sql_timestamp_birthday_def->strftime('%Y-%m-%d %H:%M:%S'), '2002-01-03 00:00:00', 'timestamp 5'); eval { $p->sql_timestamp_birthday('asdf') }; ok($@, 'Invalid timestamp'); # # bitfield # if($p->db->driver eq 'pg') { is($p->bitfield(2)->to_Bin, '00000000000000000000000000000010', 'bitfield get_set 1'); is($p->bitfield->to_Bin, '00000000000000000000000000000010', 'bitfield get_set 2'); is($p->set_bitfield(1010)->to_Bin, '00000000000000000000000000001010', 'bitfield set 1'); eval { $p->set_bitfield() }; ok($@, 'bitfield set 2'); is($p->get_bitfield->to_Bin, '00000000000000000000000000001010', 'bitfield get'); $p->sql_bits(2); is($p->sql_bits()->to_Bin, '00000000000000000000000000000010', 'bitfield() 2'); $p->sql_bits(1010); is($p->sql_bits()->to_Bin, '00000000000000000000000000001010', 'bitfield() 1010'); $p->sql_bits(5.0); is($p->sql_bits()->to_Bin, '00000000000000000000000000000101', 'bitfield() 5.0'); ok($p->sql_bits_intersects('100'), 'bitfield() intsersects 1'); ok(!$p->sql_bits_intersects('1000'), 'bitfield() intsersects 2'); $p->sql_8bits(2); is($p->sql_8bits()->to_Bin, '00000010', 'bitfield(8) 2'); $p->sql_8bits(1010); is($p->sql_8bits()->to_Bin, '00001010', 'bitfield(8) 1010'); $p->sql_8bits(5.0); is($p->sql_8bits()->to_Bin, '00000101', 'bitfield(8) 5.0'); is($p->sql_5bits3()->to_Bin, '00011', 'bitfield(5) default'); $p->sql_5bits3(2); is($p->sql_5bits3()->to_Bin, '00010', 'bitfield(5) 2'); $p->sql_5bits3(1010); is($p->sql_5bits3()->to_Bin, '01010', 'bitfield(5) 1010'); $p->sql_5bits3(5.0); is($p->sql_5bits3()->to_Bin, '00101', 'bitfield(5) 5.0'); } else { SKIP: { skip("Not connected to PostgreSQL", 17); } } # # array # if($p->db->driver eq 'pg') { local $p->{STATE_SAVING()} = 1; $p->sql_array(-1, 2.5, 3); is($p->sql_array, '{-1,2.5,3}', 'array 1'); $p->sql_array([ 'a' .. 'c' ]); is($p->sql_array, '{"a","b","c"}', 'array 2'); is($p->array(-1, 2.5, 3), '{-1,2.5,3}', 'array get_set 1'); is($p->array, '{-1,2.5,3}', 'array get_set 2'); is($p->set_array([ 'a' .. 'c' ]), '{"a","b","c"}', 'array set 1'); eval { $p->set_array() }; ok($@, 'array set 2'); is($p->get_array, '{"a","b","c"}', 'array get'); } else { SKIP: { skip("Not connected to PostgreSQL", 7); } } # # set # if($p->db->driver eq 'informix') { local $p->{STATE_SAVING()} = 1; is($p->set(-1, 2.5, 3), 'SET{-1,2.5,3}', 'set get_set 1'); is($p->set, 'SET{-1,2.5,3}', 'set get_set 2'); is($p->set_set([ 'a' .. 'c' ]), q(SET{'a','b','c'}), 'set set 1'); eval { $p->set_set() }; ok($@, 'set set 2'); is($p->get_set, q(SET{'a','b','c'}), 'set get'); } else { SKIP: { skip("Not connected to Informix", 5); } } } # # chkpass # $p->{'password_encrypted'} = ':8R1Kf2nOS0bRE'; ok($p->password_is('xyzzy'), 'chkpass() 1'); is($p->password, 'xyzzy', 'chkpass() 2'); eval { $p->set_password() }; ok($@, 'chkpass() 3'); $p->set_password('foobar'); ok($p->password_is('foobar'), 'chkpass() 4'); is($p->get_password, 'foobar', 'chkpass() 5'); BEGIN { Rose::DB->default_type('mysql'); package Person; use strict; @Person::ISA = qw(Rose::DB::Object); Person->meta->columns ( sql_date_birthday => { type => 'date' }, sql_date_birthday_def => { type => 'date' }, sql_datetime_birthday => { type => 'datetime' }, sql_datetime_birthday_def => { type => 'datetime' }, sql_timestamp_birthday => { type => 'timestamp' }, sql_timestamp_birthday_def => { type => 'timestamp' }, sql_is_happy => { type => 'boolean' }, sql_bool => { type => 'boolean' }, sql_bool_def1 => { type => 'boolean' }, sql_bits => { type => 'bitfield' }, sql_8bits => { type => 'bitfield', bits => 8 }, sql_5bits3 => { type => 'bitfield', bits => 5 }, sql_array => { type => 'array' }, ); my $meta = Person->meta; Rose::DB::Object::MakeMethods::Date->make_methods ( { target_class => 'Person' }, date => [ 'sql_date_birthday' => { column => $meta->column('sql_date_birthday') } ], date => [ 'sql_date_birthday_def' => { default => '1/1/2002', column => $meta->column('sql_date_birthday_def') } ], datetime => [ 'sql_datetime_birthday' => { column => $meta->column('sql_datetime_birthday') } ], datetime => [ 'sql_datetime_birthday_def' => { default => '1/2/2002', column => $meta->column('sql_datetime_birthday_def') } ], timestamp => [ 'sql_timestamp_birthday' => { column => $meta->column('sql_timestamp_birthday') } ], timestamp => [ 'sql_timestamp_birthday_def' => { default => '1/3/2002', column => $meta->column('sql_timestamp_birthday_def') } ], date => [ 'date', get_date => { interface => 'get', hash_key => 'date' }, set_date => { interface => 'set', hash_key => 'date' }, ], datetime => [ 'datetime', get_datetime => { interface => 'get', hash_key => 'datetime' }, set_datetime => { interface => 'set', hash_key => 'datetime' }, ], timestamp => [ 'timestamp', get_timestamp => { interface => 'get', hash_key => 'timestamp' }, set_timestamp => { interface => 'set', hash_key => 'timestamp' }, ], ); Rose::DB::Object::MakeMethods::Generic->make_methods ( { target_class => 'Person' }, scalar => [ 'scalar', get_scalar => { interface => 'get', hash_key => 'scalar' }, set_scalar => { interface => 'set', hash_key => 'scalar' }, ], character => [ character => { length => 4, overflow => 'truncate' }, character_die => { length => 4, overflow => 'fatal' }, get_character => { interface => 'get', hash_key => 'character', length => 4 }, set_character => { interface => 'set', hash_key => 'character', length => 4 }, ], varchar => [ varchar => { length => 4, overflow => 'truncate' }, varchar_die => { length => 4, overflow => 'fatal' }, get_varchar => { interface => 'get', hash_key => 'varchar', length => 4 }, set_varchar => { interface => 'set', hash_key => 'varchar', length => 4 }, ], boolean => [ 'boolean', get_boolean => { interface => 'get', hash_key => 'boolean' }, set_boolean => { interface => 'set', hash_key => 'boolean' }, ], boolean => [ 'sql_is_happy' => { column => $meta->column('sql_is_happy') } ], boolean => [ sql_bool => { column => $meta->column('sql_bool') }, sql_bool_def1 => { default => 1, column => $meta->column('sql_bool_def1') }, ], bitfield => [ 'sql_bits' => { with_intersects => 1, column => $meta->column('sql_bits') }, 'bitfield', get_bitfield => { interface => 'get', hash_key => 'bitfield' }, set_bitfield => { interface => 'set', hash_key => 'bitfield' }, ], bitfield => [ sql_8bits => { bits => 8, column => $meta->column('sql_8bits') }, sql_5bits3 => { bits => 5, default => '00011', column => $meta->column('sql_5bits3') }, ], array => [ 'sql_array' => { column => $meta->column('sql_array') } ], array => [ 'array', get_array => { interface => 'get', hash_key => 'array' }, set_array => { interface => 'set', hash_key => 'array' }, ], set => [ 'set', get_set => { interface => 'get', hash_key => 'set' }, set_set => { interface => 'set', hash_key => 'set' }, ], ); use Rose::DB::Object::MakeMethods::Pg ( chkpass => [ 'password', 'get_password' => { interface => 'get', hash_key => 'password' }, 'set_password' => { interface => 'set', hash_key => 'password' }, ], ); sub db { my $self = shift; return $self->{'db'} if($self->{'db'}); $self->{'db'} = Rose::DB->new(); $self->{'db'}->connect or die $self->{'db'}->error; return $self->{'db'}; } sub _loading { 0 } } Rose-DB-Object-0.810/t/map-record-name-conflict.pl000755 000765 000120 00000002511 11113677033 021556 0ustar00johnadmin000000 000000 #!/usr/bin/perl use Rose::DB; Rose::DB->register_db(driver => 'sqlite'); package JCS::A; use base 'Rose::DB::Object'; __PACKAGE__->meta->setup ( columns => [ qw(id a) ], relationships => [ bs => { type => 'many to many', map_class => 'JCS::AtoB', manager_args => { with_map_records => 1 }, }, ], ); package JCS::B; use base 'Rose::DB::Object'; __PACKAGE__->meta->setup ( columns => [ qw(id b) ], ); package JCS::C; use base 'Rose::DB::Object'; __PACKAGE__->meta->setup ( columns => [ qw(id c) ], relationships => [ bs => { type => 'many to many', map_class => 'JCS::CtoB', manager_args => { with_map_records => 1 }, }, ], ); package JCS::AtoB; use base 'Rose::DB::Object'; __PACKAGE__->meta->setup ( columns => [ qw(id a_id b_id) ], foreign_keys => [ a_id => { class => 'JCS::A', key_columns => { a_id => 'id' }, }, b_id => { class => 'JCS::B', key_columns => { b_id => 'id' }, } ], ); package JCS::CtoB; use base 'Rose::DB::Object'; __PACKAGE__->meta->setup ( columns => [ qw(id c_id b_id) ], foreign_keys => [ a_id => { class => 'JCS::C', key_columns => { c_id => 'id' }, }, b_id => { class => 'JCS::B', key_columns => { b_id => 'id' }, } ], ); Rose-DB-Object-0.810/t/multi-many-the-hard-way.t000644 000765 000120 00000055317 12102775334 021237 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 37; use Rose::DB::Object; BEGIN { require 't/test-lib.pl' } our %Have; our $Debug = 0; foreach my $db_type (qw(mysql)) { SKIP: { skip("$db_type tests", 37) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB->default_type($db_type); my $accounts = Rose::DB::Object::Manager->get_objects ( debug => $Debug, object_class => 'My::Account', with_objects => [ 'channels.itemMaps' ], #sort_by => 't1.accountId ASC', multi_many_ok => 1, ); test_accounts($accounts); $accounts = Rose::DB::Object::Manager->get_objects ( debug => $Debug, object_class => 'My::Account', with_objects => [ 'items.feature', 'channels.itemMaps' ], #sort_by => 't1.accountId, t2.accountId, t3.featureId, t4.accountId, t5.channelId', multi_many_ok => 1, ); test_accounts($accounts); my $iterator = Rose::DB::Object::Manager->get_objects_iterator ( debug => $Debug, object_class => 'My::Account', with_objects => [ 'items.feature', 'channels.itemMaps' ], #sort_by => 't1.accountId, t2.accountId, t3.featureId, t4.accountId, t5.channelId', multi_many_ok => 1, ); my @accounts; while(my $object = $iterator->next) { push(@accounts, $object); } test_accounts(\@accounts); COUNTER: { my $i; sub test_accounts { my ($accounts) = shift; foreach my $account (@$accounts) { $Debug && print 'Account ID ', $account->accountId . " has the following channels:\n"; foreach my $channel ( $account->channels ) { $Debug && print ' Channel ID ', $channel->channelId, " has the following items:\n"; foreach my $itemMap ( $channel->itemMaps ) { if ($Debug) { print ' Item ID ', $itemMap->itemId, ' is at position ', $itemMap->position; print " <-- incorrect because map's channelId = ", $itemMap->channelId if ( $channel->channelId != $itemMap->channelId ); print "\n"; } $i ||= 0; is( $channel->channelId, $itemMap->channelId, "id match $i" ); $i++; } } } } } eval { my $documents = Rose::DB::Object::Manager->get_objects( object_class => 'My2::DB::Object::Document', with_objects => [ 'versions.bs', 'versions.secs' ], query => [ c_id => 34639, deleted => 0, ], multi_many_ok => 1); my $iterator = Rose::DB::Object::Manager->get_objects_iterator( object_class => 'My2::DB::Object::Document', with_objects => [ 'versions.bs', 'versions.secs' ], query => [ c_id => 34639, deleted => 0, ], multi_many_ok => 1); while (my $object = $iterator->next) { ; # do nothing } }; ok(!$@, 'Multi-many 2'); } #warn $@ if $@; BEGIN { our %Have; # # MySQL # my $dbh; eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('SET FOREIGN_KEY_CHECKS = 0'); $dbh->do('DROP TABLE channel_item_map'); $dbh->do('DROP TABLE accounts'); $dbh->do('DROP TABLE channels'); $dbh->do('DROP TABLE features'); $dbh->do('DROP TABLE items'); $dbh->do('DROP TABLE ab'); $dbh->do('DROP TABLE d'); $dbh->do('DROP TABLE ds'); $dbh->do('DROP TABLE dv'); } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; Rose::DB->default_type('mysql'); $dbh->do(<<"EOF"); CREATE TABLE accounts ( accountId INT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY, owner VARCHAR(100) NOT NULL ) EOF $dbh->do($_) for(split(/;\n/, <<"EOF")); INSERT INTO accounts (accountId, owner) VALUES (1, 'Account Owner 1'); INSERT INTO accounts (accountId, owner) VALUES (2, 'Account Owner 2'); EOF $dbh->do(<<"EOF"); CREATE TABLE channels ( channelId INT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY, accountId INT UNSIGNED NOT NULL, name VARCHAR(100) NOT NULL, KEY accountId (accountId) ) EOF $dbh->do($_) for(split(/;\n/, <<"EOF")); INSERT INTO channels (channelId, accountId, name) VALUES (1, 1, 'Channel 1 Name'); INSERT INTO channels (channelId, accountId, name) VALUES (2, 1, 'Channel 2 Name'); INSERT INTO channels (channelId, accountId, name) VALUES (3, 1, 'Channel 3 Name'); INSERT INTO channels (channelId, accountId, name) VALUES (4, 2, 'Channel 4 Name'); EOF $dbh->do(<<"EOF"); CREATE TABLE features ( featureId INT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY, accountId INT UNSIGNED NOT NULL, description VARCHAR(500) NOT NULL, KEY accountId (accountId) ) EOF $dbh->do($_) for(split(/;\n/, <<"EOF")); INSERT INTO features (featureId, accountId, description) VALUES (1, 1, 'Feature 1 description.'); INSERT INTO features (featureId, accountId, description) VALUES (2, 1, 'Feature 2 description.'); INSERT INTO features (featureId, accountId, description) VALUES (3, 1, 'Feature 3 description.'); EOF $dbh->do(<<"EOF"); CREATE TABLE items ( itemId INT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY, accountId INT UNSIGNED NOT NULL, featureId INT UNSIGNED NULL, title VARCHAR(100) NOT NULL, KEY accountId (accountId), KEY featureId (featureId) ) EOF $dbh->do($_) for(split(/;\n/, <<"EOF")); INSERT INTO items (itemId, accountId, featureId, title) VALUES (1, 1, 1, 'Item 1 Title'); INSERT INTO items (itemId, accountId, featureId, title) VALUES (2, 1, 1, 'Item 2 Title'); INSERT INTO items (itemId, accountId, featureId, title) VALUES (3, 1, 2, 'Item 3 Title'); INSERT INTO items (itemId, accountId, featureId, title) VALUES (4, 1, 2, 'Item 4 Title'); INSERT INTO items (itemId, accountId, featureId, title) VALUES (5, 1, 2, 'Item 5 Title'); INSERT INTO items (itemId, accountId, featureId, title) VALUES (6, 1, 2, 'Item 6 Title'); INSERT INTO items (itemId, accountId, featureId, title) VALUES (7, 1, 3, 'Item 7 Title'); INSERT INTO items (itemId, accountId, featureId, title) VALUES (8, 1, 3, 'Item 8 Title'); INSERT INTO items (itemId, accountId, featureId, title) VALUES (9, 1, 3, 'Item 9 Title'); INSERT INTO items (itemId, accountId, featureId, title) VALUES (10, 1, 3, 'Item 10 Title'); INSERT INTO items (itemId, accountId, featureId, title) VALUES (11, 1, 3, 'Item 11 Title'); INSERT INTO items (itemId, accountId, title) VALUES (12, 2, 'Item 12 Title'); EOF $dbh->do(<<"EOF"); CREATE TABLE channel_item_map ( channelId INT UNSIGNED NOT NULL, itemId INT UNSIGNED NOT NULL, position INT UNSIGNED NOT NULL, PRIMARY KEY (channelId, position), KEY channelId (channelId), KEY itemId (itemId) ) EOF $dbh->do($_) for(split(/;\n/, <<"EOF")); INSERT INTO channel_item_map (channelId, itemId, position) VALUES (1, 1, 1); INSERT INTO channel_item_map (channelId, itemId, position) VALUES (1, 2, 2); INSERT INTO channel_item_map (channelId, itemId, position) VALUES (1, 3, 3); INSERT INTO channel_item_map (channelId, itemId, position) VALUES (1, 4, 4); INSERT INTO channel_item_map (channelId, itemId, position) VALUES (1, 5, 5); INSERT INTO channel_item_map (channelId, itemId, position) VALUES (2, 6, 1); INSERT INTO channel_item_map (channelId, itemId, position) VALUES (2, 7, 2); INSERT INTO channel_item_map (channelId, itemId, position) VALUES (3, 8, 1); INSERT INTO channel_item_map (channelId, itemId, position) VALUES (3, 9, 2); INSERT INTO channel_item_map (channelId, itemId, position) VALUES (3, 10, 3); INSERT INTO channel_item_map (channelId, itemId, position) VALUES (3, 11, 4); INSERT INTO channel_item_map (channelId, itemId, position) VALUES (4, 12, 1); EOF $dbh->do($_) for(grep { /\S/ } split(/;/, <<"EOF")); ALTER TABLE channels ADD CONSTRAINT channels_to_accounts_fk FOREIGN KEY (accountId) REFERENCES accounts (accountId) ON DELETE CASCADE; ALTER TABLE features ADD CONSTRAINT features_to_accounts_fk FOREIGN KEY (accountId) REFERENCES accounts (accountId) ON DELETE CASCADE; ALTER TABLE channel_item_map ADD CONSTRAINT channel_item_map_to_channels_fk FOREIGN KEY (channelId) REFERENCES channels (channelId) ON DELETE CASCADE, ADD CONSTRAINT channel_item_map_to_items_fk FOREIGN KEY (itemId) REFERENCES items (itemId) ON DELETE CASCADE; ALTER TABLE items ADD CONSTRAINT items_to_accounts_fk FOREIGN KEY (accountId) REFERENCES accounts (accountId) ON DELETE CASCADE, ADD CONSTRAINT items_to_features_fk FOREIGN KEY (featureId) REFERENCES features (featureId) ON DELETE CASCADE; EOF #$dbh->disconnect; package My::DB::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new } package My::Account; our @ISA = qw(My::DB::Object); __PACKAGE__->meta->setup ( table => 'accounts', columns => [ accountId => { type => 'serial', not_null => 1, }, owner => { type => 'varchar', length => 100, not_null => 1, }, ], primary_key_columns => ['accountId'], relationships => [ items => { type => 'one to many', class => 'My::Item', column_map => { accountId => 'accountId' } }, features => { type => 'one to many', class => 'My::Feature', column_map => { featureId => 'featureId' } }, channels => { type => 'one to many', class => 'My::Channel', column_map => { accountId => 'accountId' } }, ], ); package My::ChannelItemMap; our @ISA = qw(My::DB::Object); __PACKAGE__->meta->setup ( table => 'channel_item_map', columns => [ channelId => { type => 'integer', not_null => 1, }, itemId => { type => 'integer', not_null => 1, }, position => { type => 'integer', not_null => 1, }, ], primary_key_columns => [ 'channelId', 'position' ], foreign_keys => [ channel => { class => 'My::Channel', key_columns => { channelId => 'channelId' }, }, item => { class => 'My::Item', key_columns => { itemId => 'itemId' }, }, ], ); package My::Channel; our @ISA = qw(My::DB::Object); __PACKAGE__->meta->setup ( table => 'channels', columns => [ channelId => { type => 'serial', not_null => 1, }, accountId => { type => 'integer', not_null => 1, }, name => { type => 'varchar', length => 100, not_null => 1, }, ], primary_key_columns => ['channelId'], foreign_keys => [ account => { class => 'My::Account', key_columns => { accountId => 'accountId' }, }, ], relationships => [ itemMaps => { type => 'one to many', class => 'My::ChannelItemMap', column_map => { channelId => 'channelId' }, }, ], ); package My::Feature; our @ISA = qw(My::DB::Object); __PACKAGE__->meta->setup ( table => 'features', columns => [ featureId => { type => 'serial', not_null => 1, }, accountId => { type => 'integer', not_null => 1, }, description => { type => 'varchar', length => 500, not_null => 1, }, ], primary_key_columns => ['featureId'], foreign_keys => [ account => { class => 'My::Account', key_columns => { accountId => 'accountId' }, }, ], relationships => [ items => { type => 'one to many', class => 'My::Item', column_map => { featureId => 'featureId' }, }, ], ); package My::Item; our @ISA = qw(My::DB::Object); __PACKAGE__->meta->setup ( table => 'items', columns => [ itemId => { type => 'serial', not_null => 1, }, accountId => { type => 'integer', not_null => 1, }, featureId => { type => 'integer', }, title => { type => 'varchar', length => 100, not_null => 1, }, ], primary_key_columns => ['itemId'], foreign_keys => [ account => { class => 'My::Account', key_columns => { accountId => 'accountId' }, }, feature => { class => 'My::Feature', key_columns => { featureId => 'featureId' }, }, ], relationships => [ channelMaps => { type => 'one to many', class => 'My::ChannelItemMap', column_map => { itemId => 'itemId' }, }, ], ); $dbh->do($_) for(grep { /\S/ } split(/;/, <<"EOF")); CREATE TABLE ab ( id BIGINT(20) UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY, battery_id BIGINT(20) UNSIGNED NOT NULL, dv_id bigint(20) unsigned NOT NULL ); INSERT INTO ab VALUES (265633,22,306667), (265634,22,306668), (265637,22,306670); CREATE TABLE d ( id INT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY, c_id INT UNSIGNED NOT NULL, pq VARCHAR(255) NOT NULL, accid VARCHAR(255) DEFAULT NULL, deleted INT(1) DEFAULT '0', UNIQUE KEY doc_unq1 (c_id, pq) ); INSERT INTO d VALUES (132156,34639,'lab 08:M0011740R','V00011071496',0); CREATE TABLE ds ( document_id INT UNSIGNED NOT NULL, s_id INT UNSIGNED NOT NULL ); INSERT INTO ds VALUES (385,1), (3952,1), (4151,1), (4154,1), (4469,1), (4709,1), (4711,1), (4713,1), (4714,1), (5760,1), (6112,1), (6270,1), (6280,1), (6282,1), (6283,1), (7150,1), (7283,1), (7285,1), (7477,1), (7479,1), (8654,1), (12125,1), (12127,1), (12306,1), (12308,1), (12310,1), (12776,1), (13381,1), (13385,1), (13717,1), (13752,1), (14311,1), (14312,1), (14388,1), (14389,1), (14392,1), (16625,1), (18511,1), (18513,1), (18515,1), (18908,1), (18917,1), (18918,1), (18922,1), (18923,1), (18924,1), (18926,1), (19153,1), (19155,1), (19157,1), (19165,1), (19489,1), (22535,1), (24549,1), (24551,1), (25434,1), (25507,1), (25597,1), (25605,1), (25607,1), (25644,1), (26681,1), (26682,1), (26688,1), (26689,1), (26690,1), (26691,1), (29690,1), (29692,1), (29693,1), (31032,1), (31036,1), (31038,1), (31040,1), (31044,1), (31052,1), (31054,1), (33208,1), (33215,1), (33217,1), (33219,1), (34543,1), (36633,1), (36858,1), (36864,1), (36871,1), (36873,1), (38303,1), (39159,1), (39186,1), (39653,1), (39655,1), (40662,1), (40664,1), (40669,1), (40671,1), (44727,1), (44732,1), (44735,1), (44737,1), (45061,1), (45063,1), (45064,1), (46037,1), (46039,1), (46044,1), (46696,1), (46697,1), (46705,1), (46709,1), (46710,1), (46712,1), (47580,1), (47582,1), (47585,1), (48113,1), (48115,1), (52374,1), (56361,1), (56370,1), (56373,1), (56379,1), (56990,1), (56997,1), (57013,1), (57100,1), (57114,1), (57115,1), (57116,1), (57117,1), (57118,1), (57120,1), (58980,1), (58982,1), (58988,1), (59234,1), (60198,1), (60719,1), (60724,1), (60726,1), (60893,1), (60895,1), (60896,1), (60905,1), (60907,1), (60908,1), (62360,1), (62362,1), (62367,1), (62691,1), (62697,1), (62700,1), (62703,1), (63795,1), (63807,1), (63809,1), (63811,1), (63974,1), (63976,1), (63980,1), (63986,1), (63993,1), (63997,1), (64170,1), (65224,1), (66565,1), (66568,1), (66570,1), (66576,1), (66943,1), (66944,1), (66945,1), (66946,1), (66947,1), (66948,1), (67829,1), (67830,1), (67832,1), (68280,1), (70071,1), (70073,1), (70074,1), (70189,1), (70191,1), (70192,1), (71404,1), (71411,1), (71412,1), (71423,1), (71426,1), (71428,1), (72034,1), (72035,1), (72041,1), (72043,1), (72047,1), (73848,1), (73853,1), (74527,1), (74643,1), (74645,1), (76348,1), (76351,1), (76352,1), (80843,1), (80845,1), (80848,1), (81423,1), (81425,1), (81433,1), (81667,1), (82497,1), (82597,1), (82604,1), (82605,1), (82607,1), (84571,1), (84574,1), (84576,1), (84586,1), (84860,1), (84873,1), (84875,1), (84877,1), (85796,1), (86047,1), (86049,1), (86621,1), (87242,1), (87243,1), (88762,1), (88764,1), (88767,1), (88771,1), (88776,1), (88779,1), (88958,1), (88964,1), (88966,1), (90035,1), (92485,1), (92487,1), (92758,1), (93549,1), (93551,1), (93561,1), (95296,1), (95560,1), (95724,1), (95736,1), (95737,1), (95738,1), (95746,1), (97592,1), (99377,1), (101388,1), (101390,1), (101391,1), (101507,1), (101517,1), (102003,1), (102748,1), (102749,1), (103525,1), (104347,1), (104358,1), (104361,1), (104448,1), (104478,1), (104555,1), (106771,1), (106778,1), (106988,1), (106990,1), (107780,1), (107783,1), (107785,1), (110554,1), (111333,1), (111335,1), (111355,1), (111359,1), (111361,1), (111363,1), (112149,1), (112151,1), (112833,1), (113902,1), (114190,1), (114192,1), (116154,1), (116161,1), (116162,1), (116164,1), (117490,1), (117492,1), (118065,1), (118067,1), (119498,1), (119741,1), (120936,1), (120978,1), (121069,1), (121072,1), (121075,1), (122939,1), (122943,1), (123817,1), (124142,1), (124248,1), (124250,1), (126837,1), (126838,1), (126842,1), (126843,1), (126844,1), (126845,1), (126847,1), (128136,1), (128138,1), (128140,1), (129881,1), (131002,1), (131007,1), (131010,1), (131012,1), (131536,1), (131538,1), (131922,1), (131924,1), (131926,1), (133203,1), (133205,1), (133207,1), (133777,1), (133785,1), (133787,1), (134804,1), (134806,1), (134812,1), (134816,1), (135811,1), (135817,1), (135819,1), (135820,1), (136227,1), (136229,1), (137796,1), (137805,1), (137811,1), (138115,1), (138117,1), (138120,1); CREATE TABLE dv ( id INT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY, document_id INT UNSIGNED NOT NULL ); INSERT INTO dv VALUES (306667,132156), (306668,132156), (306670,132156); EOF $dbh->disconnect; package My2::DB::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new } package My2::DB::Object::DocumentVersion; our @ISA = qw(My2::DB::Object); __PACKAGE__->meta->setup ( table => 'dv', columns => [ id => { type => 'bigserial', not_null => 1 }, document_id => { type => 'bigint', not_null => 1 }, ], primary_key_columns => [ 'id' ], foreign_keys => [ d => { class => 'My2::DB::Object::Document', key_columns => { 'document_id' => 'id' }, }, ], relationships => [ bs => { class => 'My2::DB::Object::AB', column_map => { id => 'dv_id' }, type => 'one to many', }, secs => { class => 'My2::DB::Object::DocumentSecurity', column_map => { id => 'document_id' }, type => 'one to many', }, ], ); package My2::DB::Object::DocumentSecurity; our @ISA = qw(My2::DB::Object); __PACKAGE__->meta->setup ( table => 'ds', columns => [ document_id => { type => 'bigint', not_null => 1 }, s_id => { type => 'bigint', not_null => 1 }, ], primary_key_columns => [ 'document_id', 's_id' ], foreign_keys => [ flag => { class => 'My2::DB::Object::SecurityFlag', key_columns => { 's_id' => 'id' }, }, ], ); package My2::DB::Object::AB; our @ISA = qw(My2::DB::Object); __PACKAGE__->meta->setup( table => 'ab', columns => [ id => { type => 'bigserial', not_null => 1 }, battery_id => { type => 'bigint', not_null => 1 }, dv_id => { type => 'bigint', not_null => 1 }, ], primary_key_columns => [ 'id' ], foreign_key => [ dv => { class => 'My2::DB::Object::DocumentVersion', key_columns => { 'dv_id' => 'id' }, }, ], ); package My2::DB::Object::Document; our @ISA = qw(My2::DB::Object); __PACKAGE__->meta->setup ( table => 'd', columns => [ id => { type => 'bigserial', not_null => 1 }, c_id => { type => 'bigint', not_null => 1 }, pq => { type => 'varchar', length => 255 }, accid => { type => 'varchar', length => 255 }, deleted => { type => 'int', length => 1 }, ], primary_key_columns => ['id'], unique_key => [ 'c_id', 'pq' ], foreign_keys => [ chart => { class => 'My2::DB::Object::Chart', key_columns => { 'c_id' => 'id' }, }, ], relationships => [ versions => { class => 'My2::DB::Object::DocumentVersion', column_map => { id => 'document_id' }, type => 'one to many', manager_args => { sort_by => My2::DB::Object::DocumentVersion->meta->table . '.id DESC', }, }, version => { class => 'My2::DB::Object::DocumentVersion', column_map => { id => 'document_id' }, type => 'one to one', manager_args => { sort_by => My2::DB::Object::DocumentVersion->meta->table . '.id DESC', limit => 1, }, }, read_status => { class => 'My2::DB::Object::ResultReadStatus', column_map => { id => 'document_id' }, type => 'one to many', } ], ); } } END { # Delete test tables if($Have{'mysql'}) { my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('SET FOREIGN_KEY_CHECKS = 0'); $dbh->do('DROP TABLE channel_item_map'); $dbh->do('DROP TABLE accounts'); $dbh->do('DROP TABLE channels'); $dbh->do('DROP TABLE features'); $dbh->do('DROP TABLE items'); $dbh->do('DROP TABLE ab'); $dbh->do('DROP TABLE d'); $dbh->do('DROP TABLE ds'); $dbh->do('DROP TABLE dv'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/multi-pk-sequences.t000755 000765 000120 00000023202 11225465612 020375 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 2 + (2 * 24); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Loader'); } our(%HAVE, $DID_SETUP); $DID_SETUP = 0; # dumb # # Tests # #$Rose::DB::Object::Manager::Debug = 1; my $i = 1; foreach my $db_type (qw(pg pg_with_schema)) { SKIP: { skip("$db_type tests", 24) unless($HAVE{$db_type}); } next unless($HAVE{$db_type}); $i++; Rose::DB->default_type($db_type); Rose::DB::Object::Metadata->unregister_all_classes; my $class_prefix = ucfirst($db_type eq 'pg_with_schema' ? 'pgws' : $db_type); #$Rose::DB::Object::Metadata::Debug = 1; my $loader = Rose::DB::Object::Loader->new( db => Rose::DB->new, class_prefix => $class_prefix); my @classes = $loader->make_classes(include_tables => '(?i)Rose_db_object_test2?'); my $object_class = $class_prefix . '::RoseDbObjectTest'; ## ## Run tests ## if($db_type eq 'pg') { is_deeply(scalar $object_class->meta->primary_key->sequence_names, [ 'rose_db_object_test_id1_seq', 'rdbo_seq2' ], "pk sequence names 1 - $db_type"); } elsif($db_type eq 'pg_with_schema') { is_deeply(scalar $object_class->meta->primary_key->sequence_names, [ 'rose_db_object_private.rose_db_object_test_id1_seq', 'rose_db_object_private.rdbo_seq2' ], "pk sequence names 1 - $db_type"); } else { SKIP { skip("non-pg tests", 1); } } my $o = $object_class->new(name => "Sled $i"); $o->save; is($o->id1, 1, "pk 1 - $db_type"); is($o->id2, 1, "pk 2 - $db_type"); $o = $object_class->new(name => "Kite $i"); $o->save; is($o->id1, 2, "pk 3 - $db_type"); is($o->id2, 2, "pk 4 - $db_type"); my @seqs = $o->meta->primary_key->sequence_names; is(scalar @seqs, 2, "sequences 1 - $db_type"); is($seqs[0], ($db_type eq 'pg_with_schema' ? 'rose_db_object_private.' : '') . 'rose_db_object_test_id1_seq', "sequences 2 - $db_type"); is($seqs[1], ($db_type eq 'pg_with_schema' ? 'rose_db_object_private.' : '') . 'rdbo_seq2', "sequences 3 - $db_type"); $object_class .= '2'; if($db_type eq 'pg') { is_deeply(scalar $object_class->meta->primary_key->sequence_names, [ undef, 'rdbo_seq2_2' ], "pk sequence names 2 - $db_type"); } elsif($db_type eq 'pg_with_schema') { is_deeply(scalar $object_class->meta->primary_key->sequence_names, [ undef, 'rose_db_object_private.rdbo_seq2_2' ], "pk sequence names 2 - $db_type"); } else { SKIP { skip("non-pg tests", 1); } } $o = $object_class->new(id1 => 10, name => "Sled $i"); $o->save; is($o->id1, 10, "pk 5 - $db_type"); is($o->id2, 1, "pk 6 - $db_type"); $o = $object_class->new(id1 => 20, name => "Kite $i"); $o->save; is($o->id1, 20, "pk 7 - $db_type"); is($o->id2, 2, "pk 8 - $db_type"); @seqs = $o->meta->primary_key->sequence_names; is(scalar @seqs, 2, "sequences 4 - $db_type"); ok(!defined $seqs[0], "sequences 5 - $db_type"); is($seqs[1], ($db_type eq 'pg_with_schema' ? 'rose_db_object_private.' : '') . 'rdbo_seq2_2', "sequences 6 - $db_type"); if($db_type eq 'pg') { $o = MyPgObject->new(name => "Barn $i"); $o->save; is($o->id1, 3, "pk 9 - $db_type"); is($o->id2, 3, "pk 10 - $db_type"); $o = MyPgObject2->new(id1 => 30, name => "Barn $i"); $o->save; is($o->id1, 30, "pk 9 - $db_type"); is($o->id2, 3, "pk 10 - $db_type"); is_deeply(scalar MyPgObject->meta->primary_key->sequence_names, [ 'rose_db_object_test_id1_seq', 'rdbo_seq2' ], "pk sequence names 3 - $db_type"); is_deeply(scalar MyPgObject->meta->primary_key_sequence_names(MyPgObject->init_db), [ 'rose_db_object_test_id1_seq', 'rdbo_seq2' ], "pk sequence names 4 - $db_type"); is_deeply(scalar MyPgObject2->meta->primary_key->sequence_names, [ undef, 'rdbo_seq2_2' ], "pk sequence names 5 - $db_type"); is_deeply(scalar MyPgObject2->meta->primary_key_sequence_names(MyPgObject2->init_db), [ undef, 'rdbo_seq2_2' ], "pk sequence names 6 - $db_type"); } elsif($db_type eq 'pg_with_schema') { $o = MyPgWSObject->new(name => "Barn $i"); $o->save; is($o->id1, 3, "pk 9 - $db_type"); is($o->id2, 3, "pk 10 - $db_type"); $o = MyPgWSObject2->new(id1 => 30, name => "Barn $i"); $o->save; is($o->id1, 30, "pk 9 - $db_type"); is($o->id2, 3, "pk 10 - $db_type"); is_deeply(scalar MyPgWSObject->meta->primary_key->sequence_names, [ 'Rose_db_object_private.rose_db_object_test_id1_seq', 'Rose_db_object_private.rdbo_seq2' ], "pk sequence names 3 - $db_type"); is_deeply(scalar MyPgWSObject->meta->primary_key_sequence_names(MyPgWSObject->init_db), [ 'Rose_db_object_private.rose_db_object_test_id1_seq', 'Rose_db_object_private.rdbo_seq2' ], "pk sequence names 4 - $db_type"); is_deeply(scalar MyPgWSObject2->meta->primary_key->sequence_names, [ undef, 'Rose_db_object_private.rdbo_seq2_2' ], "pk sequence names 5 - $db_type"); is_deeply(scalar MyPgWSObject2->meta->primary_key_sequence_names(MyPgWSObject2->init_db), [ undef, 'Rose_db_object_private.rdbo_seq2_2' ], "pk sequence names 6 - $db_type"); } else { SKIP { skip("non-pg tests", 8); } } } BEGIN { our %HAVE; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $HAVE{'pg'} = 1; $HAVE{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_test'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_test'); $dbh->do('DROP TABLE Rose_db_object_test2 CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_test2 CASCADE'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); $dbh->do('DROP SEQUENCE rdbo_seq2'); $dbh->do('DROP SEQUENCE rdbo_seq2_2'); $dbh->do('DROP SEQUENCE Rose_db_object_private.rdbo_seq2'); $dbh->do('DROP SEQUENCE Rose_db_object_private.rdbo_seq2_2'); $dbh->do('CREATE SEQUENCE rdbo_seq2'); $dbh->do('CREATE SEQUENCE rdbo_seq2_2'); $dbh->do('CREATE SEQUENCE Rose_db_object_private.rdbo_seq2'); $dbh->do('CREATE SEQUENCE Rose_db_object_private.rdbo_seq2_2'); } $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_test ( id1 SERIAL NOT NULL, id2 INT NOT NULL DEFAULT nextval('rdbo_seq2'), name VARCHAR(255), PRIMARY KEY (id1, id2) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.Rose_db_object_test ( id1 SERIAL NOT NULL, id2 INT NOT NULL DEFAULT nextval('Rose_db_object_private.rdbo_seq2'), name VARCHAR(255), PRIMARY KEY (id1, id2) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_test2 ( id1 INT NOT NULL, id2 INT NOT NULL DEFAULT nextval('rdbo_seq2_2'), name VARCHAR(255), PRIMARY KEY (id1, id2) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.Rose_db_object_test2 ( id1 INT NOT NULL, id2 INT NOT NULL DEFAULT nextval('Rose_db_object_private.rdbo_seq2_2'), name VARCHAR(255), PRIMARY KEY (id1, id2) ) EOF $dbh->disconnect; package MyPgObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } MyPgObject->meta->table('Rose_db_object_test'); MyPgObject->meta->columns(id1 => { type => 'serial' }, qw(id2 name)); MyPgObject->meta->column('id2')->default_value_sequence_name('rdbo_seq2'); MyPgObject->meta->primary_key_columns(qw(id1 id2)); MyPgObject->meta->initialize; package MyPgWSObject; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg_with_schema') } MyPgWSObject->meta->table('Rose_db_object_test'); MyPgWSObject->meta->columns(qw(id1 id2 name)); MyPgWSObject->meta->primary_key_columns(qw(id1 id2)); MyPgWSObject->meta->primary_key->sequence_names( 'Rose_db_object_private.rose_db_object_test_id1_seq', 'Rose_db_object_private.rdbo_seq2'); MyPgWSObject->meta->initialize; package MyPgObject2; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } MyPgObject2->meta->table('Rose_db_object_test2'); MyPgObject2->meta->columns(qw(id1 id2 name)); MyPgObject2->meta->column('id2')->default_value_sequence_name('rdbo_seq2_2'); MyPgObject2->meta->primary_key_columns(qw(id1 id2)); MyPgObject2->meta->initialize; package MyPgWSObject2; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg_with_schema') } MyPgWSObject2->meta->table('Rose_db_object_test2'); MyPgWSObject2->meta->columns(qw(id1 id2 name)); MyPgWSObject2->meta->primary_key_columns(qw(id1 id2)); MyPgWSObject2->meta->primary_key->sequence_names( undef, 'Rose_db_object_private.rdbo_seq2_2'); MyPgWSObject2->meta->initialize; } } END { # Delete test table if($HAVE{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_test2 CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_test2 CASCADE'); $dbh->do('DROP SEQUENCE rdbo_seq2'); $dbh->do('DROP SEQUENCE rdbo_seq2_2'); $dbh->do('DROP SEQUENCE Rose_db_object_private.rdbo_seq2'); $dbh->do('DROP SEQUENCE Rose_db_object_private.rdbo_seq2_2'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/nested-joins.t000755 000765 000120 00000007353 11113677033 017253 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 3; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Manager'); } if(defined $ENV{'RDBO_NESTED_JOINS'} && Rose::DB::Object::Manager->can('default_nested_joins')) { Rose::DB::Object::Manager->default_nested_joins($ENV{'RDBO_NESTED_JOINS'}); } our %Have; # # Tests # foreach my $db_type (qw(mysql)) { SKIP: { skip("$db_type tests", 1) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB->default_type($db_type); my $class = ucfirst($db_type) . '::A'; my $as = Rose::DB::Object::Manager->get_objects( #debug => 1, object_class => $class, with_objects => [ 'bs.c' ]); is(scalar @$as, 2, "check count - $db_type"); } BEGIN { our %Have; # # MySQL # my $dbh; eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test_b'); $dbh->do('DROP TABLE rose_db_object_test_a'); $dbh->do('DROP TABLE rose_db_object_test_c'); } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_a ( id INT PRIMARY KEY, name VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_c ( id INT PRIMARY KEY, name VARCHAR(255)); EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_b ( id INT PRIMARY KEY, name VARCHAR(255), a_id INT NOT NULL REFERENCES a (id), c_id INT NOT NULL REFERENCES c (id) ) EOF Rose::DB->default_type('mysql'); package Mysql::A; our @ISA = qw(Rose::DB::Object); __PACKAGE__->meta->setup ( table => 'rose_db_object_test_a', columns => [ qw(id name) ], relationships => [ bs => { type => 'one to many', class => 'Mysql::B', column_map => { id => 'a_id' }, }, ], ); package Mysql::B; our @ISA = qw(Rose::DB::Object); __PACKAGE__->meta->setup ( table => 'rose_db_object_test_b', columns => [ id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', length => 255 }, a_id => { type => 'integer', not_null => 1 }, c_id => { type => 'integer', not_null => 1 }, ], foreign_keys => [ a => { class => 'Mysql::A', key_columns => { a_id => 'id' }, }, c => { class => 'Mysql::C', key_columns => { a_id => 'id' }, } ], ); package Mysql::C; our @ISA = qw(Rose::DB::Object); __PACKAGE__->meta->setup ( table => 'rose_db_object_test_c', columns => [ id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar', length => 255 }, ] ); $dbh->do("insert into rose_db_object_test_a (id, name) values (1, 'one')"); $dbh->do("insert into rose_db_object_test_a (id, name) values (2, 'two')"); $dbh->do("insert into rose_db_object_test_c (id, name) values (1, 'c one')"); $dbh->do("insert into rose_db_object_test_c (id, name) values (2, 'c two')"); $dbh->do("insert into rose_db_object_test_b (id, name, a_id, c_id) values (1, 'b one', 1, 1)"); $dbh->disconnect; } } END { # Delete test tables if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test_b'); $dbh->do('DROP TABLE rose_db_object_test_a'); $dbh->do('DROP TABLE rose_db_object_test_c'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/one-to-many-reset.t000755 000765 000120 00000015320 11653604702 020127 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 1 + (12 * 4); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Loader'); } our %Have; # # Tests # #$Rose::DB::Object::Manager::Debug = 1; foreach my $db_type (qw(mysql pg informix sqlite)) { SKIP: { skip("$db_type tests", 12) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB->default_type($db_type); my $class_prefix = ucfirst($db_type); my $loader = Rose::DB::Object::Loader->new( db => Rose::DB->new, class_prefix => $class_prefix); my @classes = $loader->make_classes(include_tables => '^rose_db_object_(?:artist|album)s$'); #foreach my $class (@classes) #{ # print $class->meta->perl_class_definition, "\n" if($class->can('meta')); #} my $artist_class = $class_prefix . '::RoseDbObjectArtist'; my $album_class = $class_prefix . '::RoseDbObjectAlbum'; # DBD::Informix chokes badly when prepare_cached() is used. Rose::DB::Object::Metadata->dbi_prepare_cached($db_type eq 'informix' ? 0 : 1); my $albums_method = 'rose_db_object_albums'; foreach my $cascade (0, 1) { my @cascade = $cascade ? (cascade => 1) : (); my $album = $album_class->new(id => 1, title => 'album1'); $album->save(); my $artist = $artist_class->new(id => 1, name => 'Rage'); $artist->$albums_method($album->id); $artist->save(@cascade); ok($artist, "$cascade saved artist with albums - $db_type"); $artist->$albums_method($album->id); $artist->save(@cascade); ok($artist, "$cascade re-saved artist albums = $db_type"); $artist = $artist_class->new(id => $artist->id)->load; is(scalar @{$artist->$albums_method() ||[]}, 1, "$cascade Check artist albums count - $db_type"); is($artist->$albums_method()->[0]->id, $album->id, "$cascade Check artist album ids - $db_type"); my @albums = $artist->$albums_method(); $artist->$albums_method(@albums); $artist->save; $artist->$albums_method(@albums); $artist->save; $artist = $artist_class->new(id => $artist->id)->load; is(scalar @{$artist->$albums_method() ||[]}, 1, "$cascade Check artist albums count 2 - $db_type"); is($artist->$albums_method()->[0]->id, $album->id, "$cascade Check artist album ids 2 - $db_type"); $artist->delete(cascade => 1); } } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_albums'); $dbh->do('DROP TABLE rose_db_object_artists'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_artists ( id INT PRIMARY KEY NOT NULL, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_albums ( id INT PRIMARY KEY NOT NULL, artist_id INTEGER REFERENCES rose_db_object_artists (id), title VARCHAR(255) NOT NULL ) EOF $dbh->disconnect; } # # MySQL # eval { die "No InnoDB support" unless(mysql_supports_innodb()); my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_albums'); $dbh->do('DROP TABLE rose_db_object_artists'); } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_artists ( id INT PRIMARY KEY NOT NULL, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_albums ( id INT PRIMARY KEY NOT NULL, artist_id INTEGER REFERENCES rose_db_object_artists (id), title VARCHAR(255) NOT NULL, INDEX(artist_id), FOREIGN KEY (artist_id) REFERENCES rose_db_object_artists (id) ) ENGINE=InnoDB EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_albums'); $dbh->do('DROP TABLE rose_db_object_artists'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_artists ( id INT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_albums ( id INT PRIMARY KEY, artist_id INT REFERENCES rose_db_object_artists (id), title VARCHAR(255) NOT NULL ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_albums'); $dbh->do('DROP TABLE rose_db_object_artists'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_artists ( id INT PRIMARY KEY NOT NULL, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_albums ( id INT PRIMARY KEY NOT NULL, artist_id INTEGER REFERENCES rose_db_object_artists (id), title VARCHAR(255) NOT NULL ) EOF $dbh->disconnect; } } END { # Delete test table if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_albums'); $dbh->do('DROP TABLE rose_db_object_artists'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_albums'); $dbh->do('DROP TABLE rose_db_object_artists'); $dbh->disconnect; } if($Have{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_albums CASCADE'); $dbh->do('DROP TABLE rose_db_object_artists CASCADE'); $dbh->disconnect; } if($Have{'sqlite'}) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_albums'); $dbh->do('DROP TABLE rose_db_object_artists'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/pk-fk-columns.t000755 000765 000120 00000012341 11653604702 017332 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 2 + (4 * 1); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Loader'); } our(%Have); # # Tests # #$Rose::DB::Object::Manager::Debug = 1; foreach my $db_type (qw(mysql pg informix sqlite)) { SKIP: { skip("$db_type tests", 1) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB->default_type($db_type); my $class_prefix = ucfirst($db_type); my $loader = Rose::DB::Object::Loader->new( db => Rose::DB->new, class_prefix => $class_prefix); my @classes = $loader->make_classes(include_tables => 'rose_db_object.*'); #foreach my $class (@classes) #{ # print $class->meta->perl_class_definition(braces => 'k&r', indent => 2) # if($class->can('meta')); #} my $a_class = $class_prefix . '::RoseDbObjectA'; my $b_class = $class_prefix . '::RoseDbObjectB'; my $a = $a_class->new(id => 1, name => 'A')->save; my $b = $b_class->new(id => 1, name => 'B')->save; $b = $b_class->new(id => 1)->load; $b->rose_db_object_a(undef); eval { $b->save }; ok(!$@, "pk fk column - $db_type"); } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_b'); $dbh->do('DROP TABLE rose_db_object_a'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_a ( id INTEGER NOT NULL PRIMARY KEY, name VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_b ( id INTEGER NOT NULL PRIMARY KEY, name VARCHAR(255), FOREIGN KEY (id) REFERENCES rose_db_object_a (id) ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; die "MySQL version too old" unless($db->database_version >= 4_000_000 && mysql_supports_innodb()); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_b'); $dbh->do('DROP TABLE rose_db_object_a'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_a ( id INTEGER NOT NULL PRIMARY KEY, name VARCHAR(255) ) ENGINE=InnoDB EOF }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_b ( id INTEGER NOT NULL PRIMARY KEY, name VARCHAR(255), FOREIGN KEY (id) REFERENCES rose_db_object_a (id) ) ENGINE=InnoDB EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_b'); $dbh->do('DROP TABLE rose_db_object_a'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_a ( id INTEGER NOT NULL PRIMARY KEY, name VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_b ( id INTEGER NOT NULL PRIMARY KEY, name VARCHAR(255), FOREIGN KEY (id) REFERENCES rose_db_object_a (id) ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_b'); $dbh->do('DROP TABLE rose_db_object_a'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_a ( id INTEGER NOT NULL PRIMARY KEY, name VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_b ( id INTEGER NOT NULL PRIMARY KEY, name VARCHAR(255), FOREIGN KEY (id) REFERENCES rose_db_object_a (id) ) EOF $dbh->disconnect; } } END { # Delete test table if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_b'); $dbh->do('DROP TABLE rose_db_object_a'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_b'); $dbh->do('DROP TABLE rose_db_object_a'); $dbh->disconnect; } if($Have{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_b'); $dbh->do('DROP TABLE rose_db_object_a'); $dbh->disconnect; } if($Have{'sqlite'}) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_b'); $dbh->do('DROP TABLE rose_db_object_a'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/pod.t000755 000765 000120 00000000253 11113677033 015423 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More; eval 'use Test::Pod 1.00'; plan(skip_all => 'Test::Pod 1.00 required for testing POD') if($@); all_pod_files_ok(); Rose-DB-Object-0.810/t/query-builder.t000644 000765 000120 00000002032 11317404611 017420 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 2; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::QueryBuilder'); Rose::DB::Object::QueryBuilder->import(qw(build_select)); } SKIP: { skip("all tests", 1) unless(have_db('sqlite_admin')); my $dbh = get_dbh('sqlite'); my $sql = build_select ( dbh => $dbh, select => 'COUNT(*)', tables => [ 'articles' ], columns => { articles => [ qw(id category type title date) ] }, query => [ category => [ 'sports', 'science' ], type => 'news', title => { like => [ '%million%', '%resident%' ] }, id => [ \q(id), 1 ], ], query_is_sql => 1 ); is($sql . "\n", <<"EOF", 'build_select() IN scalar ref'); SELECT COUNT(*) FROM articles t1 WHERE t1.id IN (id, '1') AND t1.category IN ('sports', 'science') AND t1.type = 'news' AND (t1.title LIKE '%million%' OR t1.title LIKE '%resident%') EOF # XXX: Need more tests here... } Rose-DB-Object-0.810/t/rt-cpan-45836.t000644 000765 000120 00000005206 11365606261 016700 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 1 + (5 * 1); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Loader'); } our %Have; # # Tests # #$Rose::DB::Object::Manager::Debug = 1; foreach my $db_type (qw(sqlite)) { SKIP: { skip("$db_type tests", 5) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB::Object::Metadata->unregister_all_classes; Rose::DB->default_type($db_type); my $class_prefix = ucfirst($db_type); my $loader = Rose::DB::Object::Loader->new( db => Rose::DB->new, class_prefix => $class_prefix); my @classes = $loader->make_classes(include_tables => '^(foos|bars)$'); #foreach my $class (@classes) #{ # print $class->meta->perl_class_definition if($class->can('meta')); #} my $foo_class = $class_prefix . '::Foo'; my $bar_class = $class_prefix . '::Bar'; is($foo_class->meta->relationship('bar')->type, 'one to one', "check rel type - $db_type"); my $bar = $bar_class->new; my $foo = $foo_class->new(foo => 'xyz'); #$Rose::DB::Object::Debug = 1; $foo->bar($bar); $foo->bar->bar('some text'); $foo->save; my $check_foo = $foo_class->new(id => $foo->id)->load; my $check_bar = $bar_class->new(foo_id => $bar->foo_id)->load; is($check_foo->foo, 'xyz', "check foo - $db_type"); is($check_bar->bar, 'some text', "check bar - $db_type"); is($bar_class->meta->relationship('foo')->type, 'one to one', "check foo one to one - $db_type"); is($bar_class->meta->relationship('foo')->foreign_key, $bar_class->meta->foreign_key('foo'), "check foo fk rel - $db_type"); #foreach my $rel ($bar_class->meta->relationships) #{ # print $rel->name, ' ', $rel->type, "\n"; #} } BEGIN { our %Have; my $dbh; # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE bars'); $dbh->do('DROP TABLE foos'); } $dbh->do(<<"EOF"); CREATE TABLE foos ( id INTEGER PRIMARY KEY AUTOINCREMENT, foo VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE "bars" ( "foo_id" INTEGER PRIMARY KEY AUTOINCREMENT REFERENCES foos (id), bar VARCHAR(255) ) EOF $dbh->disconnect; } } END { # Delete test tables if($Have{'sqlite'}) { my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE bars'); $dbh->do('DROP TABLE foos'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/sandbox/000750 000765 000120 00000000000 12266514755 016115 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/save-cascade.t000755 000765 000120 00000025137 11653604702 017172 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 1 + (22 * 4); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Loader'); } our %Have; # # Tests # #$Rose::DB::Object::Manager::Debug = 1; foreach my $db_type (qw(mysql pg informix sqlite)) { SKIP: { skip("$db_type tests", 22) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB::Object::Metadata->unregister_all_classes; Rose::DB->default_type($db_type); my $class_prefix = ucfirst($db_type); my $loader = Rose::DB::Object::Loader->new( db => Rose::DB->new, class_prefix => $class_prefix); my @classes = $loader->make_classes(include_tables => '^(?:products|prices|colors|vendors|product_colors)$'); #foreach my $class (@classes) #{ # print $class->meta->perl_class_definition if($class->can('meta')); #} my $product_class = $class_prefix . '::Product'; my $vendor_class = $class_prefix . '::Vendor'; my $price_class = $class_prefix . '::Price'; my $color_class = $class_prefix . '::Color'; foreach my $i (0, 1) { $product_class->meta->default_update_changes_only($i); $product_class->meta->default_insert_changes_only($i); # Foreign key my $p = $product_class->new(name => 'p1', vendor => { name => 'v1' }); $p->save; $p = $product_class->new(id => $p->id)->load; my $v = $p->vendor; $v->name('v1.1'); $p->save(cascade => 1); $v = $vendor_class->new(id => $v->id)->load; is($v->name, 'v1.1', "cascade fk 1.$i - $db_type"); # One-to-many $p->prices([ { price => 1.25 } ]); $p->save; $p = $product_class->new(id => $p->id)->load; my $price = $p->prices->[0]; is($price->price, 1.25, "cascade one-to-many 1.$i - $db_type"); is($price->region, 'US', "cascade one-to-many 2.$i - $db_type"); $price->region('UK'); $p->add_prices({ price => 4.25 }); $p->save(cascade => 1); $price = $price_class->new(price_id => $price->price_id)->load; is($price->region, 'UK', "cascade one-to-many 3.$i - $db_type"); $price = (sort { $a->price <=> $b->price } @{$p->prices})[-1]; is($price->price, 4.25, "cascade one-to-many 4.$i - $db_type"); is($price->region, 'US', "cascade one-to-many 5.$i - $db_type"); # Many-to-many $p->colors([ { code => 'f00', name => 'red' } ]); $p->save; $p = $product_class->new(id => $p->id)->load; my $color = $p->colors->[0]; is($color->code, 'f00', "cascade many-to-many 1.$i - $db_type"); is($color->name, 'red', "cascade many-to-many 2.$i - $db_type"); $color->name('r3d'); $p->add_colors({ code => '0f0', name => 'green' }); $p->save(cascade => 1); $color = $color_class->new(code => $color->code)->load; is($color->name, 'r3d', "cascade many-to-many 3.$i - $db_type"); $color = (sort { $a->name cmp $b->name } @{$p->colors})[0]; is($color->code, '0f0', "cascade many-to-many 4.$i - $db_type"); is($color->name, 'green', "cascade many-to-many 5.$i - $db_type"); $p->dbh->do('DELETE FROM product_colors'); $p->dbh->do('DELETE FROM colors'); $p->dbh->do('DELETE FROM prices'); $p->dbh->do('DELETE FROM products'); $p->dbh->do('DELETE FROM vendors'); } } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL PRIMARY KEY, name VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( code CHAR(3) NOT NULL PRIMARY KEY, name VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL PRIMARY KEY, name VARCHAR(255), vendor_id INT NOT NULL REFERENCES vendors (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( price_id SERIAL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_colors ( id SERIAL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), color_code CHAR(3) NOT NULL REFERENCES colors (code) ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; die "No innodb support" unless(mysql_supports_innodb()); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( code CHAR(3) NOT NULL PRIMARY KEY, name VARCHAR(255) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255), vendor_id INT NOT NULL, UNIQUE(name), INDEX(vendor_id), FOREIGN KEY (vendor_id) REFERENCES vendors (id) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( price_id INT AUTO_INCREMENT PRIMARY KEY, product_id INT NOT NULL, region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL, INDEX(product_id), FOREIGN KEY (product_id) REFERENCES products (id) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE product_colors ( id INT AUTO_INCREMENT PRIMARY KEY, product_id INT NOT NULL, color_code CHAR(3) NOT NULL, INDEX(product_id), INDEX(color_code), FOREIGN KEY (product_id) REFERENCES products (id), FOREIGN KEY (color_code) REFERENCES colors (code) ) ENGINE=InnoDB EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id SERIAL PRIMARY KEY, name VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( code CHAR(3) NOT NULL PRIMARY KEY, name VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id SERIAL PRIMARY KEY, name VARCHAR(255), vendor_id INT NOT NULL REFERENCES vendors (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( price_id SERIAL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) DEFAULT 'US' NOT NULL, price DECIMAL(10,2) NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_colors ( id SERIAL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), color_code CHAR(3) NOT NULL REFERENCES colors (code) ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE product_colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE vendors'); } $dbh->do(<<"EOF"); CREATE TABLE vendors ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE colors ( code CHAR(3) NOT NULL PRIMARY KEY, name VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE products ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255), vendor_id INT NOT NULL REFERENCES vendors (id), UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE prices ( price_id INTEGER PRIMARY KEY AUTOINCREMENT, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE product_colors ( id INTEGER PRIMARY KEY AUTOINCREMENT, product_id INT NOT NULL REFERENCES products (id), color_code CHAR(3) NOT NULL REFERENCES colors (code) ) EOF $dbh->disconnect; } } END { # Delete test table if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if($Have{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_colors CASCADE'); $dbh->do('DROP TABLE prices CASCADE'); $dbh->do('DROP TABLE products CASCADE'); $dbh->do('DROP TABLE colors CASCADE'); $dbh->do('DROP TABLE vendors CASCADE'); $dbh->disconnect; } if($Have{'sqlite'}) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE product_colors'); $dbh->do('DROP TABLE prices'); $dbh->do('DROP TABLE products'); $dbh->do('DROP TABLE colors'); $dbh->do('DROP TABLE vendors'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/schema-override.t000755 000765 000120 00000007323 11225465612 017725 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 8; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); } our %Have; # # Tests # #$Rose::DB::Object::Manager::Debug = 1; SKIP: { skip("pg tests", 7) unless($Have{'pg'}); my $db_pg = Rose::DB->new('pg'); my $db_ws = Rose::DB->new('pg_with_schema'); # Albums should take on the schema of the db handle my $a1 = Album->new(db => $db_pg, name => 'One', year => 2001)->save; my $a2 = Album->new(db => $db_ws, name => 'One', year => 2002)->save; is($a1->id, 1, 'flex schema 1'); is($a2->id, 1, 'flex schema 2'); # Album photos should NOT take on the schema of the db handle my $p1 = AlbumPhoto->new(db => $db_pg, album_id => 1, name => '1.1')->save; my $p2 = AlbumPhoto->new(db => $db_ws, album_id => 1, name => '1.2')->save; is($p1->id, 1, 'flex schema 1'); is($p2->id, 2, 'flex schema 2'); # Make sure both albums read the same album photos table is_deeply([ map { $_->name } sort { $a->id <=> $b->id } $a1->album_photos ], [ '1.1', '1.2' ], 'single photos table 1'); is_deeply([ map { $_->name } sort { $a->id <=> $b->id } $a2->album_photos ], [ '1.1', '1.2' ], 'single photos table 2'); $a1 = Album->new(id => $a1->id); $a1->load(with => 'album_photos'); is_deeply([ map { $_->name } sort { $a->id <=> $b->id } $a1->album_photos ], [ '1.1', '1.2' ], 'single photos table 3'); } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_private.rdbo_album_photos CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.rdbo_albums CASCADE'); $dbh->do('DROP TABLE rdbo_albums CASCADE'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); } $dbh->do(<<"EOF"); CREATE TABLE rdbo_albums ( id SERIAL PRIMARY KEY, name VARCHAR(32) UNIQUE, artist VARCHAR(32), year INTEGER ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.rdbo_albums ( id SERIAL PRIMARY KEY, name VARCHAR(32) UNIQUE, artist VARCHAR(32), year INTEGER ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.rdbo_album_photos ( id SERIAL PRIMARY KEY, album_id INT REFERENCES rdbo_albums (id), name VARCHAR(32) ) EOF $dbh->disconnect; Rose::DB->default_type('pg'); package MyCM; our @ISA = qw(Rose::DB::Object::ConventionManager); sub auto_relationship_name_one_to_many { my($self, $table, $class) = @_; return $self->auto_class_to_relationship_name_plural($class); } package Album; our @ISA = qw(Rose::DB::Object); Album->meta->convention_manager('MyCM'); Album->meta->table('rdbo_albums'); Album->meta->auto_initialize; package AlbumPhoto; our @ISA = qw(Rose::DB::Object); AlbumPhoto->meta->convention_manager('MyCM'); AlbumPhoto->meta->table('rdbo_album_photos'); AlbumPhoto->meta->schema('Rose_db_object_private'); AlbumPhoto->meta->auto_initialize; } } END { # Delete test table if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_private.rdbo_album_photos CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.rdbo_albums CASCADE'); $dbh->do('DROP TABLE rdbo_albums CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/spot-check-01.t000755 000765 000120 00000015440 12054157213 017121 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 82; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Manager'); } our(%HAVE, $DID_SETUP); # # Tests # #$Rose::DB::Object::Manager::Debug = 1; foreach my $db_type (qw(mysql pg pg_with_schema informix sqlite)) { SKIP: { skip("$db_type tests", 16) unless($HAVE{$db_type}); } next unless($HAVE{$db_type}); Rose::DB->default_type($db_type); unless($DID_SETUP++) { # # Setup classes # package MD; our @ISA = qw(Rose::DB::Object); MD->meta->table('Rose_db_object_MD'); MD->meta->columns(ID => { primary_key => 1 }); MD->meta->relationships ( 'mdvs' => { type => 'one to many', class => 'MDV', column_map => { ID => 'MD' }, } ); MD->meta->initialize; package MD::Mgr; our @ISA = qw(Rose::DB::Object::Manager); sub object_class { 'MD' } Rose::DB::Object::Manager->make_manager_methods('mds'); package MDV; our @ISA = qw(Rose::DB::Object); MDV->meta->table('Rose_db_object_MDV'); MDV->meta->columns ( ID => { primary_key => 1 }, MD => { type => 'int' }, ); MDV->meta->relationships ( 'md' => { type => 'many to one', class => 'MD', column_map => { MD => 'ID' }, } ); MDV->meta->initialize; } #else #{ # MD->meta->init_with_db(Rose::DB->new); # MDV->meta->init_with_db(Rose::DB->new); #} # Add data my $dbh = MD->init_db->retain_dbh; my $schema = $db_type eq 'pg_with_schema' ? 'Rose_db_object_private.' : ''; for(1 .. 3) { $dbh->do("INSERT INTO ${schema}Rose_db_object_MD (ID) VALUES ($_)"); } for(1 .. 2) { $dbh->do("INSERT INTO ${schema}Rose_db_object_MDV (ID, MD) VALUES ($_, 1)"); } # Run tests my $i = 0; foreach my $arg (qw(MD mdvs.MD t2.MD Rose_db_object_MDV.MD)) { $i++; my $mds = MD::Mgr->get_mds(distinct => 1, with_objects => [ 'mdvs' ], query => [ 'MD' => undef ], sort_by => 'ID'); ok($mds, "get_mds() $i.1 - $db_type"); ok(@$mds == 2, "get_mds() $i.2 - $db_type"); is($mds->[0]->ID, 2, "get_mds() $i.3 - $db_type"); is($mds->[1]->ID, 3, "get_mds() $i.4 - $db_type"); } } BEGIN { our %HAVE; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $HAVE{'pg'} = 1; $HAVE{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_MD'); $dbh->do('DROP TABLE Rose_db_object_MDV'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_MD'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_MDV'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); } our $PG_HAS_CHKPASS = pg_has_chkpass(); $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_MD ( ID SERIAL NOT NULL PRIMARY KEY ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_MDV ( ID SERIAL NOT NULL PRIMARY KEY, MD INT NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.Rose_db_object_MD ( ID SERIAL NOT NULL PRIMARY KEY ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.Rose_db_object_MDV ( ID SERIAL NOT NULL PRIMARY KEY, MD INT NOT NULL ) EOF $dbh->disconnect; } # # MySQL # eval { $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $HAVE{'mysql'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_MD'); $dbh->do('DROP TABLE Rose_db_object_MDV'); } our $PG_HAS_CHKPASS = 1 unless($@); $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_MD ( ID INT UNSIGNED AUTO_INCREMENT PRIMARY KEY ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_MDV ( ID INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, MD INT NOT NULL ) EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $HAVE{'informix'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_MD'); $dbh->do('DROP TABLE Rose_db_object_MDV'); } our $PG_HAS_CHKPASS = 1 unless($@); $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_MD ( ID SERIAL NOT NULL PRIMARY KEY ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_MDV ( ID SERIAL NOT NULL PRIMARY KEY, MD INT NOT NULL ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $HAVE{'sqlite'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_MD'); $dbh->do('DROP TABLE Rose_db_object_MDV'); } our $PG_HAS_CHKPASS = 1 unless($@); $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_MD ( ID INTEGER PRIMARY KEY AUTOINCREMENT ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_MDV ( ID INTEGER PRIMARY KEY AUTOINCREMENT, MD INT NOT NULL ) EOF $dbh->disconnect; } } END { # Delete test table if($HAVE{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_MD'); $dbh->do('DROP TABLE Rose_db_object_MDV'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_MD'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_MDV'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->disconnect; } if($HAVE{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_MD'); $dbh->do('DROP TABLE Rose_db_object_MDV'); $dbh->disconnect; } if($HAVE{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_MD'); $dbh->do('DROP TABLE Rose_db_object_MDV'); $dbh->disconnect; } if($HAVE{'sqlite'}) { # SQLite my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_MD'); $dbh->do('DROP TABLE Rose_db_object_MDV'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/spot-check-02.t000755 000765 000120 00000026521 11653604702 017130 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 32; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Manager'); } our(%HAVE, $DID_SETUP); # # Tests # #$Rose::DB::Object::Manager::Debug = 1; foreach my $db_type (qw(mysql pg pg_with_schema informix sqlite)) { SKIP: { skip("$db_type tests", 6) unless($HAVE{$db_type}); } next unless($HAVE{$db_type}); Rose::DB->default_type($db_type); unless($DID_SETUP++) { # Load classes use FindBin qw($Bin); use lib "$Bin/lib"; require My::DB::Gene::Main; require My::DB::Unigene::Main; } # Run tests is(join(', ', map { $_->name } My::DB::Gene2Unigene->meta->foreign_keys), 'Rose_db_object_g_main, Rose_db_object_ug_main', "foreign_keys 1 - $db_type"); is(join(', ', map { $_->name . ' ' . $_->type} My::DB::Gene::Main->meta->relationships), 'unigenes many to many', "relationships 1 - $db_type"); is(join(', ', map { $_->name . ' ' . $_->type} My::DB::Unigene::Main->meta->relationships), 'genes many to many', "relationships 2 - $db_type"); is(scalar @Rose::DB::Object::Metadata::Deferred_Relationships || 0, 0, "deferred relationships - $db_type"); # XXX: switch entirely to per-db SQL? #My::DB::Gene::Main->meta->init_with_db(Rose::DB->new); #My::DB::Unigene::Main->meta->init_with_db(Rose::DB->new); my $g = My::DB::Gene::Main->new; eval { $g->unigenes }; ok(!$@, "unigenes - $db_type"); $g = My::DB::Unigene::Main->new; eval { $g->genes }; ok(!$@, "genes - $db_type"); } BEGIN { our %HAVE; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $HAVE{'pg'} = 1; $HAVE{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_g_ug CASCADE'); $dbh->do('DROP TABLE Rose_db_object_ug_main CASCADE'); $dbh->do('DROP TABLE Rose_db_object_g_main CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_g_ug CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_ug_main CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_g_main CASCADE'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); } $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_ug_main ( ug_id VARCHAR PRIMARY KEY NOT NULL, species VARCHAR, symbol VARCHAR, description VARCHAR, cytoband VARCHAR, scount INTEGER, homol VARCHAR, rest_expr VARCHAR, mgi VARCHAR ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_g_main ( tax_id INTEGER, gene_id INTEGER PRIMARY KEY, symbol VARCHAR, locustag VARCHAR, chromosome VARCHAR, map_location VARCHAR, description VARCHAR, gene_type VARCHAR, symbol_from_nomenclature_auth VARCHAR, full_name_from_nomenclature_auth VARCHAR, nomenclature_status VARCHAR, discontinued BOOLEAN DEFAULT FALSE, new_gene_id INTEGER DEFAULT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_g_ug ( g_ug_id SERIAL PRIMARY KEY, gene_id INTEGER REFERENCES Rose_db_object_g_main (gene_id) ON UPDATE CASCADE ON DELETE CASCADE DEFERRABLE, ug_id VARCHAR REFERENCES Rose_db_object_ug_main (ug_id) ON UPDATE CASCADE ON DELETE CASCADE DEFERRABLE ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.Rose_db_object_ug_main ( ug_id VARCHAR PRIMARY KEY NOT NULL, species VARCHAR, symbol VARCHAR, description VARCHAR, cytoband VARCHAR, scount INTEGER, homol VARCHAR, rest_expr VARCHAR, mgi VARCHAR ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.Rose_db_object_g_main ( tax_id INTEGER, gene_id INTEGER PRIMARY KEY, symbol VARCHAR, locustag VARCHAR, chromosome VARCHAR, map_location VARCHAR, description VARCHAR, gene_type VARCHAR, symbol_from_nomenclature_auth VARCHAR, full_name_from_nomenclature_auth VARCHAR, nomenclature_status VARCHAR, discontinued BOOLEAN DEFAULT FALSE, new_gene_id INTEGER DEFAULT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.Rose_db_object_g_ug ( g_ug_id SERIAL PRIMARY KEY, gene_id INTEGER REFERENCES Rose_db_object_private.Rose_db_object_g_main (gene_id) ON UPDATE CASCADE ON DELETE CASCADE DEFERRABLE, ug_id VARCHAR REFERENCES Rose_db_object_private.Rose_db_object_ug_main (ug_id) ON UPDATE CASCADE ON DELETE CASCADE DEFERRABLE ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; die "MySQL version too old" unless($db->database_version >= 4_000_000 && mysql_supports_innodb()); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_g_ug CASCADE'); $dbh->do('DROP TABLE Rose_db_object_ug_main CASCADE'); $dbh->do('DROP TABLE Rose_db_object_g_main CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_ug_main ( ug_id VARCHAR(255) NOT NULL PRIMARY KEY, species VARCHAR(255), symbol VARCHAR(255), description VARCHAR(255), cytoband VARCHAR(255), scount INT, homol VARCHAR(255), rest_expr VARCHAR(255), mgi VARCHAR(255) ) ENGINE=InnoDB EOF }; if(!$@ && $dbh) { $HAVE{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_g_main ( gene_id INT NOT NULL PRIMARY KEY, tax_id INT, symbol VARCHAR(255), locustag VARCHAR(255), chromosome VARCHAR(255), map_location VARCHAR(255), description VARCHAR(255), gene_type VARCHAR(255), symbol_from_nomenclature_auth VARCHAR(255), full_name_from_nomenclature_auth VARCHAR(255), nomenclature_status VARCHAR(255), discontinued INT DEFAULT 0, new_gene_id INT DEFAULT NULL ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_g_ug ( g_ug_id INT PRIMARY KEY, gene_id INT NOT NULL, ug_id VARCHAR(255) NOT NULL, INDEX(gene_id), INDEX(ug_id), FOREIGN KEY (gene_id) REFERENCES Rose_db_object_g_main (gene_id), FOREIGN KEY (ug_id) REFERENCES Rose_db_object_ug_main (ug_id) ) ENGINE=InnoDB EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $HAVE{'informix'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_g_ug'); $dbh->do('DROP TABLE Rose_db_object_ug_main'); $dbh->do('DROP TABLE Rose_db_object_g_main'); } $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_ug_main ( ug_id VARCHAR(255) NOT NULL PRIMARY KEY, species VARCHAR(255), symbol VARCHAR(255), description VARCHAR(255), cytoband VARCHAR(255), scount INT, homol VARCHAR(255), rest_expr VARCHAR(255), mgi VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_g_main ( tax_id INT, gene_id INT PRIMARY KEY, symbol VARCHAR(255), locustag VARCHAR(255), chromosome VARCHAR(255), map_location VARCHAR(255), description VARCHAR(255), gene_type VARCHAR(255), symbol_from_nomenclature_auth VARCHAR(255), full_name_from_nomenclature_auth VARCHAR(255), nomenclature_status VARCHAR(255), discontinued INT DEFAULT 0, new_gene_id INT DEFAULT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_g_ug ( g_ug_id SERIAL PRIMARY KEY, gene_id INT REFERENCES Rose_db_object_g_main (gene_id), ug_id VARCHAR(255) REFERENCES Rose_db_object_ug_main (ug_id) ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $HAVE{'sqlite'} = 1; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_g_ug'); $dbh->do('DROP TABLE Rose_db_object_ug_main'); $dbh->do('DROP TABLE Rose_db_object_g_main'); } $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_ug_main ( ug_id VARCHAR(255) NOT NULL PRIMARY KEY, species VARCHAR(255), symbol VARCHAR(255), description VARCHAR(255), cytoband VARCHAR(255), scount INT, homol VARCHAR(255), rest_expr VARCHAR(255), mgi VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_g_main ( tax_id INT, gene_id INT PRIMARY KEY, symbol VARCHAR(255), locustag VARCHAR(255), chromosome VARCHAR(255), map_location VARCHAR(255), description VARCHAR(255), gene_type VARCHAR(255), symbol_from_nomenclature_auth VARCHAR(255), full_name_from_nomenclature_auth VARCHAR(255), nomenclature_status VARCHAR(255), discontinued INT DEFAULT 0, new_gene_id INT DEFAULT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_g_ug ( g_ug_id INTEGER PRIMARY KEY AUTOINCREMENT, gene_id INTEGER REFERENCES Rose_db_object_g_main (gene_id), ug_id VARCHAR(255) REFERENCES Rose_db_object_ug_main (ug_id) ) EOF $dbh->disconnect; } } END { # Delete test table if($HAVE{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_g_ug CASCADE'); $dbh->do('DROP TABLE Rose_db_object_ug_main CASCADE'); $dbh->do('DROP TABLE Rose_db_object_g_main CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_g_ug CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_ug_main CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_g_main CASCADE'); $dbh->disconnect; } if($HAVE{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_g_ug CASCADE'); $dbh->do('DROP TABLE Rose_db_object_ug_main CASCADE'); $dbh->do('DROP TABLE Rose_db_object_g_main CASCADE'); $dbh->disconnect; } if($HAVE{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_g_ug CASCADE'); $dbh->do('DROP TABLE Rose_db_object_ug_main CASCADE'); $dbh->do('DROP TABLE Rose_db_object_g_main CASCADE'); $dbh->disconnect; } if($HAVE{'sqlite'}) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_g_ug'); $dbh->do('DROP TABLE Rose_db_object_ug_main'); $dbh->do('DROP TABLE Rose_db_object_g_main'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/spot-check-03.t000755 000765 000120 00000006133 11113677033 017124 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Data::Dumper; use Test::More tests => 4; BEGIN { use_ok('Rose::DB::SQLite'); } my $sql =<<"EOF"; create table foo ( name varchar(255), id int primary key, unique(name) ) EOF my @r = Rose::DB::SQLite->_info_from_sql($sql); #print Dumper(\@r); is_deeply(\@r, [ [ { 'NULLABLE' => 1, 'CHAR_OCTET_LENGTH' => '255', 'COLUMN_SIZE' => '255', 'ORDINAL_POSITION' => 1, 'TYPE_NAME' => 'varchar', 'COLUMN_NAME' => 'name' }, { 'NULLABLE' => 1, 'ORDINAL_POSITION' => 2, 'TYPE_NAME' => 'int', 'COLUMN_NAME' => 'id' } ], [ 'id' ], [ [ 'name' ] ] ], 'sqlite parse 1'); $sql =<<"EOF"; create table foo ( name varchar(255), id int primary key, primary key ( id , name ) , unique ( name ) ) EOF @r = Rose::DB::SQLite->_info_from_sql($sql); #print Dumper(\@r); is_deeply(\@r, [ [ { 'NULLABLE' => 1, 'CHAR_OCTET_LENGTH' => '255', 'COLUMN_SIZE' => '255', 'ORDINAL_POSITION' => 1, 'TYPE_NAME' => 'varchar', 'COLUMN_NAME' => 'name' }, { 'NULLABLE' => 1, 'ORDINAL_POSITION' => 2, 'TYPE_NAME' => 'int', 'COLUMN_NAME' => 'id' } ], [ 'id', 'name' ], [ [ 'name' ] ] ], 'sqlite parse 2'); $sql =<<"EOF"; create table foo ( name varchar(255) not null default "Jo""h'n'" , baz not null references blah (id), blee DATETIME not null default '2005-01-21 12:34:56', -- test id int CONSTRAINT foo not null ON Conflict fAil CONSTRAINT bar primary key AUTOINCREMENT DEFAULT /* This is a bug -- comment foo bar -- baz -- */ 123 CHECK(fo ( bar b ( 'a''z' ) ) ), str varchar ( 64 ) not null default '-- "foo" '' -- /* blah */', unique ( 'name' ), Foreign KEY 'foo''bar' (id) references `blah ` ( 'a', b , asd) ) /* foo bar create table blah This is legal! See: http://www.sqlite.org/lang_comment.html EOF @r = Rose::DB::SQLite->_info_from_sql($sql); #print Dumper(\@r); is_deeply(\@r, [ [ { 'NULLABLE' => 0, 'CHAR_OCTET_LENGTH' => '255', 'COLUMN_SIZE' => '255', 'COLUMN_DEF' => 'Jo"h\'n\'', 'ORDINAL_POSITION' => 1, 'TYPE_NAME' => 'varchar', 'COLUMN_NAME' => 'name' }, { 'NULLABLE' => 0, 'ORDINAL_POSITION' => 2, 'TYPE_NAME' => 'scalar', 'COLUMN_NAME' => 'baz' }, { 'NULLABLE' => 0, 'COLUMN_DEF' => '2005-01-21 12:34:56', 'ORDINAL_POSITION' => 3, 'TYPE_NAME' => 'DATETIME', 'COLUMN_NAME' => 'blee' }, { 'NULLABLE' => 0, 'COLUMN_DEF' => '123', 'ORDINAL_POSITION' => 4, 'TYPE_NAME' => 'serial', 'COLUMN_NAME' => 'id' }, { 'NULLABLE' => 0, 'CHAR_OCTET_LENGTH' => '64', 'COLUMN_SIZE' => '64', 'COLUMN_DEF' => '-- "foo" \' -- /* blah */', 'ORDINAL_POSITION' => 5, 'TYPE_NAME' => 'varchar', 'COLUMN_NAME' => 'str' } ], [ 'id' ], [ [ 'name' ] ] ], 'sqlite parse 3'); Rose-DB-Object-0.810/t/spot-check-04.t000755 000765 000120 00000024263 12247526104 017132 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 11; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Loader'); } our %Have; # # Tests # #$Rose::DB::Object::Manager::Debug = 1; foreach my $db_type (qw(mysql pg pg_with_schema informix sqlite)) { SKIP: { skip("$db_type tests", 2) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB->default_type($db_type); my $class_prefix = ucfirst($db_type eq 'pg_with_schema' ? 'pgws' : $db_type) . 'MusicDB'; my $loader = Rose::DB::Object::Loader->new( db => Rose::DB->new, class_prefix => $class_prefix); my @classes = $loader->make_classes(include_tables => 'rdbo_album.*'); #foreach my $class (@classes) #{ # print $class->meta->perl_class_definition(braces => 'k&r', indent => 2) # if($class->can('meta')); #} my $manager_class = $class_prefix . '::RdboAlbumArtwork::Manager'; my $results = $manager_class->get_rdbo_album_artwork( query => [ art_filename => 'album1.jpg' ], sort_by => 'art_filename'); foreach my $res (@$results) { my $album = $res->album; is($album->name, 'album1', "album 1 - $db_type"); } LEAK_TEST: { $RDBO::LeakTest = 0; my $db_class = ref(Rose::DB->new); no strict 'refs'; no warnings 'redefine'; *{"${db_class}::DESTROY"} = sub { $_[0]->disconnect; $RDBO::LeakTest++; }; INNER: { my $iter = $manager_class->get_rdbo_album_artwork_iterator( query => [ art_filename => 'album1.jpg' ], sort_by => 'art_filename'); while(my $res = $iter->next) { # do nothing } } ok($RDBO::LeakTest > 0, "iterator db leak check - $db_type"); } } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rdbo_album_artwork CASCADE'); $dbh->do('DROP TABLE rdbo_albums CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.rdbo_album_artwork CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.rdbo_albums CASCADE'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); } $dbh->do(<<"EOF"); CREATE TABLE rdbo_albums ( id INTEGER PRIMARY KEY, other_id VARCHAR(32) UNIQUE, name VARCHAR(32), artist VARCHAR(32), year INTEGER ) EOF $dbh->do(<<"EOF"); CREATE TABLE rdbo_album_artwork ( art_filename VARCHAR(32) PRIMARY KEY, album_other_id VARCHAR(32) REFERENCES rdbo_albums (other_id) ) EOF $dbh->do(qq(INSERT INTO rdbo_albums VALUES (1, 'id1', 'album1', 'artist1', 1999))); $dbh->do(qq(INSERT INTO rdbo_albums VALUES (2, 'id2', 'album2', 'artist1', 2000))); $dbh->do(qq(INSERT INTO rdbo_albums VALUES (3, 'id3', 'album3', 'artist2', 1934))); $dbh->do(qq(INSERT INTO rdbo_albums VALUES (4, 'id4', 'album4', 'artist2', 2020))); $dbh->do(qq(INSERT INTO rdbo_album_artwork VALUES ('album1.jpg', 'id1'))); $dbh->do(qq(INSERT INTO rdbo_album_artwork VALUES ('album2.jpg', 'id2'))); $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.rdbo_albums ( id INTEGER PRIMARY KEY, other_id VARCHAR(32) UNIQUE, name VARCHAR(32), artist VARCHAR(32), year INTEGER ) EOF $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.rdbo_album_artwork ( art_filename VARCHAR(32) PRIMARY KEY, album_other_id VARCHAR(32) REFERENCES Rose_db_object_private.rdbo_albums (other_id) ) EOF $dbh->do(qq(INSERT INTO Rose_db_object_private.rdbo_albums VALUES (1, 'id1', 'album1', 'artist1', 1999))); $dbh->do(qq(INSERT INTO Rose_db_object_private.rdbo_albums VALUES (2, 'id2', 'album2', 'artist1', 2000))); $dbh->do(qq(INSERT INTO Rose_db_object_private.rdbo_albums VALUES (3, 'id3', 'album3', 'artist2', 1934))); $dbh->do(qq(INSERT INTO Rose_db_object_private.rdbo_albums VALUES (4, 'id4', 'album4', 'artist2', 2020))); $dbh->do(qq(INSERT INTO Rose_db_object_private.rdbo_album_artwork VALUES ('album1.jpg', 'id1'))); $dbh->do(qq(INSERT INTO Rose_db_object_private.rdbo_album_artwork VALUES ('album2.jpg', 'id2'))); $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; die "MySQL version too old" unless($db->database_version >= 4_000_000); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rdbo_album_artwork CASCADE'); $dbh->do('DROP TABLE rdbo_albums CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE rdbo_albums ( id INTEGER PRIMARY KEY, other_id VARCHAR(32) UNIQUE, name VARCHAR(32), artist VARCHAR(32), year INTEGER ) ENGINE=InnoDB EOF # MySQL will silently ignore the "ENGINE=InnoDB" part and create # a MyISAM table instead. MySQL is evil! Now we have to manually # check to make sure an InnoDB table was really created. my $db_name = $db->database; my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?"); $sth->execute('rdbo_albums'); my $info = $sth->fetchrow_hashref; no warnings 'uninitialized'; unless(lc $info->{'Type'} eq 'innodb' || lc $info->{'Engine'} eq 'innodb') { die "Missing InnoDB support"; } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE rdbo_album_artwork ( art_filename VARCHAR(32) PRIMARY KEY, album_other_id VARCHAR(32), INDEX(album_other_id), FOREIGN KEY (album_other_id) REFERENCES rdbo_albums (other_id) ) ENGINE=InnoDB EOF $dbh->do(qq(INSERT INTO rdbo_albums VALUES (1, 'id1', 'album1', 'artist1', 1999))); $dbh->do(qq(INSERT INTO rdbo_albums VALUES (2, 'id2', 'album2', 'artist1', 2000))); $dbh->do(qq(INSERT INTO rdbo_albums VALUES (3, 'id3', 'album3', 'artist2', 1934))); $dbh->do(qq(INSERT INTO rdbo_albums VALUES (4, 'id4', 'album4', 'artist2', 2020))); $dbh->do(qq(INSERT INTO rdbo_album_artwork VALUES ('album1.jpg', 'id1'))); $dbh->do(qq(INSERT INTO rdbo_album_artwork VALUES ('album2.jpg', 'id2'))); $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rdbo_album_artwork CASCADE'); $dbh->do('DROP TABLE rdbo_albums CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE rdbo_albums ( id INTEGER PRIMARY KEY, other_id VARCHAR(32) UNIQUE, name VARCHAR(32), artist VARCHAR(32), year INTEGER ) EOF $dbh->do(<<"EOF"); CREATE TABLE rdbo_album_artwork ( art_filename VARCHAR(32) PRIMARY KEY, album_other_id VARCHAR(32) REFERENCES rdbo_albums (other_id) ) EOF $dbh->do(qq(INSERT INTO rdbo_albums VALUES (1, 'id1', 'album1', 'artist1', 1999))); $dbh->do(qq(INSERT INTO rdbo_albums VALUES (2, 'id2', 'album2', 'artist1', 2000))); $dbh->do(qq(INSERT INTO rdbo_albums VALUES (3, 'id3', 'album3', 'artist2', 1934))); $dbh->do(qq(INSERT INTO rdbo_albums VALUES (4, 'id4', 'album4', 'artist2', 2020))); $dbh->do(qq(INSERT INTO rdbo_album_artwork VALUES ('album1.jpg', 'id1'))); $dbh->do(qq(INSERT INTO rdbo_album_artwork VALUES ('album2.jpg', 'id2'))); $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rdbo_album_artwork CASCADE'); $dbh->do('DROP TABLE rdbo_albums CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE rdbo_albums ( id INTEGER PRIMARY KEY, other_id VARCHAR(32) UNIQUE, name VARCHAR(32), artist VARCHAR(32), year INTEGER ) EOF $dbh->do(<<"EOF"); CREATE TABLE rdbo_album_artwork ( art_filename VARCHAR(32) PRIMARY KEY, album_other_id VARCHAR(32) REFERENCES rdbo_albums (other_id) ) EOF $dbh->do(qq(INSERT INTO rdbo_albums VALUES (1, 'id1', 'album1', 'artist1', 1999))); $dbh->do(qq(INSERT INTO rdbo_albums VALUES (2, 'id2', 'album2', 'artist1', 2000))); $dbh->do(qq(INSERT INTO rdbo_albums VALUES (3, 'id3', 'album3', 'artist2', 1934))); $dbh->do(qq(INSERT INTO rdbo_albums VALUES (4, 'id4', 'album4', 'artist2', 2020))); $dbh->do(qq(INSERT INTO rdbo_album_artwork VALUES ('album1.jpg', 'id1'))); $dbh->do(qq(INSERT INTO rdbo_album_artwork VALUES ('album2.jpg', 'id2'))); $dbh->disconnect; } } END { # Delete test table if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rdbo_album_artwork CASCADE'); $dbh->do('DROP TABLE rdbo_albums CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.rdbo_album_artwork CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.rdbo_albums CASCADE'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rdbo_album_artwork CASCADE'); $dbh->do('DROP TABLE rdbo_albums CASCADE'); $dbh->disconnect; } if($Have{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rdbo_album_artwork CASCADE'); $dbh->do('DROP TABLE rdbo_albums CASCADE'); $dbh->disconnect; } if($Have{'sqlite'}) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rdbo_album_artwork'); $dbh->do('DROP TABLE rdbo_albums'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/spot-check-05.t000755 000765 000120 00000004221 11113677033 017122 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 3; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Loader'); } our %Have; # # Tests # #$Rose::DB::Object::Manager::Debug = 1; foreach my $db_type (qw(mysql)) { SKIP: { skip("$db_type tests", 2) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB->default_type($db_type); my $class_prefix = ucfirst($db_type); my $loader = Rose::DB::Object::Loader->new( db => Rose::DB->new, class_prefix => $class_prefix); my @classes = $loader->make_classes(include_tables => 'rdbo_company_vote'); is(scalar @classes, 2, "uppercase keys - $db_type"); my $o = Mysql::RdboCompanyVote->new; if($db_type eq 'mysql') { is($o->meta->column('canmeet')->perl_hash_definition, q(canmeet => { type => 'enum', check_in => [ 'YES', 'NO' ], default => 'YES', not_null => 1 }), "enum column defintion - $db_type"); } else { ok(1, "non-mysql - $db_type") } } BEGIN { # # MySQL # my $dbh; eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rdbo_company_vote CASCADE'); } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE rdbo_company_vote ( vote_id INT(10) UNSIGNED NOT NULL AUTO_INCREMENT , company_id INT(10) UNSIGNED NOT NULL DEFAULT '0', question_id INT(10) UNSIGNED NOT NULL DEFAULT '0', rating_num TINYINT(3) UNSIGNED DEFAULT NULL , comment VARCHAR(255) DEFAULT NULL, canmeet ENUM('YES','NO') NOT NULL DEFAULT 'YES', PRIMARY KEY (vote_id, company_id, question_id), UNIQUE KEY IDX_company_rating1 (company_id, question_id), KEY IDX_company_vote2 (company_id) , KEY IDX_company_vote3 (question_id) ) EOF $dbh->disconnect; } } END { if($Have{'mysql'}) { my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rdbo_company_vote CASCADE'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/spot-check-06.t000755 000765 000120 00000007637 11225465612 017143 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 5; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Loader'); } our %Have; # # Tests # #$Rose::DB::Object::Manager::Debug = 1; foreach my $db_type (qw(mysql pg informix sqlite)) { SKIP: { skip("$db_type tests", 1) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB->default_type($db_type); my $class_prefix = ucfirst($db_type); my $loader = Rose::DB::Object::Loader->new( db => Rose::DB->new, class_prefix => $class_prefix); my @classes = $loader->make_classes(include_tables => '^rose_db_object_test$'); my $object_class = $class_prefix . '::RoseDbObjectTest'; my $sql = Rose::DB::Object::Manager->get_objects_sql( object_class => $object_class, query => [ start => undef ]); # Really, I'm looking for a lack of warning in this test, but # I'm not sure how to check for that using Test::More. ok($sql =~ /.?start.? IS NULL/, "sql check - $db_type"); } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INTEGER PRIMARY KEY, start TIMESTAMP ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INTEGER PRIMARY KEY, start DATETIME ) EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INTEGER PRIMARY KEY, start DATETIME YEAR TO SECOND ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test ( id INTEGER PRIMARY KEY, start DATETIME ) EOF $dbh->disconnect; } } END { # Delete test table if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } if($Have{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } if($Have{'sqlite'}) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/spot-check-07.t000755 000765 000120 00000006372 11113677033 017135 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 4; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); } our %Have; # # Tests # foreach my $db_type (qw(mysql)) { SKIP: { skip("$db_type tests", 3) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB->default_type($db_type); my $class = ucfirst($db_type) . 'Foo'; my $o = $class->new(name => 'f1: ' . localtime(), children => [ { name => 'c1: ' . localtime() }, { name => 'c2: ' . localtime() }, ]); $o->save; my $p = $class->new(id => $o->id); ok($p->load, "parent - $db_type"); my $c1 = $class->new(id => $o->children->[0]->id); ok($c1->load, "child 1 - $db_type"); my $c2 = $class->new(id => $o->children->[1]->id); ok($c2->load, "child 2 - $db_type"); } BEGIN { our %Have; # # MySQL # my $dbh; eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test_foo'); $dbh->do('DROP TABLE rose_db_object_test_foo_parent'); } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_foo ( id INT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_foo_parent ( parent_id INT UNSIGNED NOT NULL REFERENCES rose_db_object_test_foo (id), child_id INT UNSIGNED NOT NULL REFERENCES rose_db_object_test_foo (id), PRIMARY KEY(parent_id, child_id) ) EOF $dbh->disconnect; Rose::DB->default_type('mysql'); package MysqlFoo; our @ISA = qw(Rose::DB::Object); MysqlFoo->meta->table('rose_db_object_test_foo'); MysqlFoo->meta->columns(qw(id name)); MysqlFoo->meta->primary_key_columns('id'); MysqlFoo->meta->add_unique_key('name'); MysqlFoo->meta->relationships ( parents => { type => 'many to many', map_class => 'MysqlFooParent', map_from => 'child', map_to => 'parent', }, children => { type => 'many to many', map_class => 'MysqlFooParent', map_from => 'parent', map_to => 'child', }, ); MysqlFoo->meta->initialize; package MysqlFooParent; our @ISA = qw(Rose::DB::Object); MysqlFooParent->meta->table('rose_db_object_test_foo_parent'); MysqlFooParent->meta->columns(qw(parent_id child_id)); MysqlFooParent->meta->primary_key_columns(qw(parent_id child_id)); MysqlFooParent->meta->foreign_keys ( parent => { class => 'MysqlFoo', key_columns => { parent_id => 'id' } }, child => { class => 'MysqlFoo', key_columns => { child_id => 'id' } }, ); MysqlFooParent->meta->initialize; } } END { # Delete test tables if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test_foo'); $dbh->do('DROP TABLE rose_db_object_test_foo_parent'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/spot-check-08.t000755 000765 000120 00000010121 11225465612 017123 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 7; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); } our $HAVE_PG; SKIP: foreach my $db_type (qw(pg pg_with_schema)) { skip("PostgreSQL tests", 6) unless($HAVE_PG); OVERRIDE_OK: { no warnings; *MyPgObject::init_db = sub { Rose::DB->new($db_type) }; } my $o = MyPgObject->new(name => 'John', k1 => 1, k2 => undef, k3 => 3); ok(ref $o && $o->isa('MyPgObject'), "new() 1 - $db_type"); $o->flag2('TRUE'); $o->date_created('now'); $o->last_modified($o->date_created); $o->save_col(7); ok($o->save, "save() 1 - $db_type"); is($o->id, 1, "auto-generated primary key - $db_type"); } BEGIN { # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { our $HAVE_PG = 1; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE Rose_db_object_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_chkpass_test'); $dbh->do('DROP SEQUENCE Rose_db_object_test_seq'); $dbh->do('DROP SEQUENCE Rose_db_object_private.Rose_db_object_test_seq'); $dbh->do('CREATE SCHEMA Rose_db_object_private'); } our $PG_HAS_CHKPASS = pg_has_chkpass(); $dbh->do('CREATE SEQUENCE Rose_db_object_test_seq'); my $pg_vers = $dbh->{'pg_server_version'}; my $active = $pg_vers >= 80100 ? q('act''ive') : q('act\'ive'); $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_test ( id INT DEFAULT nextval('Rose_db_object_test_seq') NOT NULL PRIMARY KEY, k1 INT, k2 INT, k3 INT, @{[ $PG_HAS_CHKPASS ? 'password CHKPASS,' : '' ]} name VARCHAR(32) NOT NULL, code CHAR(6), flag BOOLEAN NOT NULL DEFAULT 't', flag2 BOOLEAN, status VARCHAR(32) DEFAULT $active, bits BIT(5) NOT NULL DEFAULT B'00101', start DATE DEFAULT '1980-12-24', save INT, nums INT[], last_modified TIMESTAMP, date_created TIMESTAMP, UNIQUE(save), UNIQUE(k1, k2, k3) ) EOF $dbh->do('CREATE SEQUENCE Rose_db_object_private.Rose_db_object_test_seq'); $dbh->do(<<"EOF"); CREATE TABLE Rose_db_object_private.Rose_db_object_test ( id INT DEFAULT nextval('Rose_db_object_test_seq') NOT NULL PRIMARY KEY, k1 INT, k2 INT, k3 INT, @{[ $PG_HAS_CHKPASS ? 'password CHKPASS,' : '' ]} name VARCHAR(32) NOT NULL, code CHAR(6), flag BOOLEAN NOT NULL DEFAULT 't', flag2 BOOLEAN, status VARCHAR(32) DEFAULT $active, bits BIT(5) NOT NULL DEFAULT B'00101', start DATE DEFAULT '1980-12-24', save INT, nums INT[], last_modified TIMESTAMP, date_created TIMESTAMP, UNIQUE(save), UNIQUE(k1, k2, k3) ) EOF $dbh->disconnect; Rose::DB->default_type('pg'); package MyTmpPgObject; use Rose::DB::Object::Helpers qw(clone); our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('pg') } MyTmpPgObject->meta->table('Rose_db_object_test'); MyTmpPgObject->meta->auto_initialize; my $code = MyTmpPgObject->meta->perl_class_definition; $code =~ s/\bMyTmpPgObject\b/MyPgObject/g; eval $code; die $@ if($@); } } END { # Delete test table if($HAVE_PG) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE Rose_db_object_test CASCADE'); $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_test CASCADE'); $dbh->do('DROP SEQUENCE Rose_db_object_test_seq'); $dbh->do('DROP SEQUENCE Rose_db_object_private.Rose_db_object_test_seq'); $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/spot-check-09.t000755 000765 000120 00000012746 11653604702 017143 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 1 + (5 * 4); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Loader'); } our %Have; # # Tests # #$Rose::DB::Object::Manager::Debug = 1; foreach my $db_type (qw(mysql pg informix sqlite)) { SKIP: { skip("$db_type tests", 5) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB::Object::Metadata->unregister_all_classes; Rose::DB->default_type($db_type); my $class_prefix = ucfirst($db_type); my $loader = Rose::DB::Object::Loader->new( db => Rose::DB->new, class_prefix => $class_prefix); my @classes = $loader->make_classes(include_tables => '^(foos|bars)$'); #foreach my $class (@classes) #{ # print $class->meta->perl_class_definition if($class->can('meta')); #} my $foo_class = $class_prefix . '::Foo'; my $bar_class = $class_prefix . '::Bar'; is($foo_class->meta->relationship('bar')->type, 'one to one', "check rel type - $db_type"); my $bar = $bar_class->new; my $foo = $foo_class->new(foo => 'xyz'); #$Rose::DB::Object::Debug = 1; $foo->bar($bar); $foo->bar->bar('some text'); $foo->save; my $check_foo = $foo_class->new(id => $foo->id)->load; my $check_bar = $bar_class->new(foo_id => $bar->foo_id)->load; is($check_foo->foo, 'xyz', "check foo - $db_type"); is($check_bar->bar, 'some text', "check bar - $db_type"); is($bar_class->meta->relationship('foo')->type, 'one to one', "check foo one to one - $db_type"); is($bar_class->meta->relationship('foo')->foreign_key, $bar_class->meta->foreign_key('foo'), "check foo fk rel - $db_type"); #foreach my $rel ($bar_class->meta->relationships) #{ # print $rel->name, ' ', $rel->type, "\n"; #} } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE bars CASCADE'); $dbh->do('DROP TABLE foos CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE foos ( id SERIAL NOT NULL PRIMARY KEY, foo VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE bars ( foo_id INT NOT NULL PRIMARY KEY REFERENCES foos (id), bar VARCHAR(255) ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; die "No innodb support" unless(mysql_supports_innodb()); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE bars CASCADE'); $dbh->do('DROP TABLE foos CASCADE'); } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE foos ( id INT AUTO_INCREMENT PRIMARY KEY, foo VARCHAR(255) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); CREATE TABLE bars ( foo_id INT PRIMARY KEY, bar VARCHAR(255), INDEX(foo_id), FOREIGN KEY (foo_id) REFERENCES foos (id) ) ENGINE=InnoDB EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE bars CASCADE'); $dbh->do('DROP TABLE foos CASCADE'); } $dbh->do(<<"EOF"); CREATE TABLE foos ( id SERIAL NOT NULL PRIMARY KEY, foo VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE bars ( foo_id INT NOT NULL PRIMARY KEY REFERENCES foos (id), bar VARCHAR(255) ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE bars'); $dbh->do('DROP TABLE foos'); } $dbh->do(<<"EOF"); CREATE TABLE foos ( id INTEGER PRIMARY KEY AUTOINCREMENT, foo VARCHAR(255) ) EOF $dbh->do(<<"EOF"); CREATE TABLE bars ( foo_id INTEGER PRIMARY KEY AUTOINCREMENT REFERENCES foos (id), bar VARCHAR(255) ) EOF $dbh->disconnect; } } END { # Delete test table if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE bars CASCADE'); $dbh->do('DROP TABLE foos CASCADE'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE bars CASCADE'); $dbh->do('DROP TABLE foos CASCADE'); $dbh->disconnect; } if($Have{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE bars CASCADE'); $dbh->do('DROP TABLE foos CASCADE'); $dbh->disconnect; } if($Have{'sqlite'}) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE bars'); $dbh->do('DROP TABLE foos'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/spot-check-10.t000755 000765 000120 00000032300 11225465612 017117 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 2 + (6 * 1); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Loader'); use_ok('Rose::DB::Object::Helpers'); } our %Have; # # Tests # #$Rose::DB::Object::Manager::Debug = 1; foreach my $db_type (qw(pg)) { SKIP: { skip("$db_type tests", 6) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB->default_type($db_type); my $class_prefix = ucfirst($db_type); my $loader = Rose::DB::Object::Loader->new( db => Rose::DB->new, class_prefix => $class_prefix); my @classes = $loader->make_classes(include_tables => [ qw(offering_levels offering_sequences offerings employee employer) ], include_map_class_relationships => 1); #foreach my $class (@classes) #{ # print $class->meta->perl_class_definition if($class->can('meta')); #} my $employer_class = $class_prefix . '::Employer'; my $offering_class = $class_prefix . '::Offering'; my $offering_sequence_class = $class_prefix . '::OfferingSequence'; my $offering_level_class = $class_prefix . '::OfferingLevel'; $employer_class->meta->column('data')->lazy(1); $employer_class->meta->column('data')->make_methods(replace_existing => 1); Rose::DB::Object::Manager->update_objects( set => { name => { sql => 'upper(name)' } }, where => [ name => 'Default Employer' ], object_class => $employer_class); Rose::DB::Object::Manager->update_objects( set => { name => \q(name || 'x') }, where => [ name => 'DEFAULT EMPLOYER' ], object_class => $employer_class); my $employer = $employer_class->new(company_code => 'TEST', data => "\0\1x\2\3"); my @offerings = ( { sort_order => 1, years => 05, offering_sequences => [ { offering_levels => [ { catalog_level => 'C', catalog_code => 'HZNO04', } ], sequence_number => 0, years => 05, eid => '' } ] }, { sort_order => 2, years => 10, offering_sequences => [ { offering_levels => [ { catalog_level => 'E', catalog_code => 'HZNO04', } ], sequence_number => 0, years => 10, eid => '' } ] }, { sort_order => 3, years => 15, offering_sequences => [ { offering_levels => [ { catalog_level => 'H', catalog_code => 'HZNO04', } ], sequence_number => 0, years => 15, eid => '', } ] }, { sort_order => 5, years => 25, offering_sequences => [ { offering_levels => [ { catalog_level => 'P', catalog_code => 'HZNO04', } ], sequence_number => 0, years => 25, eid => '', } ] } ); $employer->add_offerings(\@offerings); #$Rose::DB::Object::Debug = 1; #$Rose::DB::Object::Manager::Debug = 1; #$DB::single = 1; $employer->save; $employer = $employer_class->new(company_code => 'TEST')->load; is($employer->{'data'}, undef, "lazy bytea 1 - $db_type"); is($employer->data, "\0\1x\2\3", "lazy bytea 2 - $db_type"); $employer->data("\0\4x\3\1"); $employer->save; my $employers = Rose::DB::Object::Manager->get_objects( object_class => $employer_class, sort_by => 'name'); is_deeply([ map { scalar $_->Rose::DB::Object::Helpers::column_value_pairs } @$employers ], [ { 'name' => '', 'company_code' => 'TEST', 'data' => "\0\4x\3\1", }, { 'name' => 'DEFAULT EMPLOYERx', 'company_code' => '', 'data' => undef, } ], "employer check - $db_type"); my $offerings = Rose::DB::Object::Manager->get_objects( object_class => $offering_class, sort_by => [ 'company_code', 'sort_order', 'years' ]); is_deeply([ map { scalar $_->Rose::DB::Object::Helpers::column_value_pairs } @$offerings ], [ { 'browse' => 1, 'discrete_sequences' => 1, 'sort_order' => '0', 'years' => '05', 'eid' => '', 'company_code' => '' }, { 'browse' => 1, 'discrete_sequences' => 1, 'sort_order' => '0', 'years' => '10', 'eid' => '', 'company_code' => '' }, { 'browse' => 1, 'discrete_sequences' => 1, 'sort_order' => '0', 'years' => '15', 'eid' => '', 'company_code' => '' }, { 'browse' => 1, 'discrete_sequences' => 1, 'sort_order' => '1', 'years' => '5', 'eid' => '', 'company_code' => 'TEST' }, { 'browse' => 1, 'discrete_sequences' => 1, 'sort_order' => '2', 'years' => '10', 'eid' => '', 'company_code' => 'TEST' }, { 'browse' => 1, 'discrete_sequences' => 1, 'sort_order' => '3', 'years' => '15', 'eid' => '', 'company_code' => 'TEST' }, { 'browse' => 1, 'discrete_sequences' => 1, 'sort_order' => '5', 'years' => '25', 'eid' => '', 'company_code' => 'TEST' } ], "offering check - $db_type"); my $offering_sequences = Rose::DB::Object::Manager->get_objects( object_class => $offering_sequence_class, sort_by => [ 'company_code', 'years' ]); is_deeply([ map { scalar $_->Rose::DB::Object::Helpers::column_value_pairs } @$offering_sequences ], [ { 'browse' => 1, 'sequence_number' => '0', 'years' => '05', 'eid' => '', 'company_code' => '' }, { 'browse' => 1, 'sequence_number' => '0', 'years' => '10', 'eid' => '', 'company_code' => '' }, { 'browse' => 1, 'sequence_number' => '0', 'years' => '15', 'eid' => '', 'company_code' => '' }, { 'browse' => 1, 'sequence_number' => '0', 'years' => '10', 'eid' => '', 'company_code' => 'TEST' }, { 'browse' => 1, 'sequence_number' => '0', 'years' => '15', 'eid' => '', 'company_code' => 'TEST' }, { 'browse' => 1, 'sequence_number' => '0', 'years' => '25', 'eid' => '', 'company_code' => 'TEST' }, { 'browse' => 1, 'sequence_number' => '0', 'years' => '5', 'eid' => '', 'company_code' => 'TEST' } ], "offering sequence check - $db_type"); my $offering_levels = Rose::DB::Object::Manager->get_objects( object_class => $offering_level_class, sort_by => [ 'company_code', 'years' ]); is_deeply([ map { scalar $_->Rose::DB::Object::Helpers::column_value_pairs } @$offering_levels ], [ { 'browse' => 1, 'sequence_number' => '0', 'catalog_level' => 'E', 'years' => '10', 'eid' => '', 'catalog_code' => 'HZNO04', 'company_code' => 'TEST' }, { 'browse' => 1, 'sequence_number' => '0', 'catalog_level' => 'H', 'years' => '15', 'eid' => '', 'catalog_code' => 'HZNO04', 'company_code' => 'TEST' }, { 'browse' => 1, 'sequence_number' => '0', 'catalog_level' => 'P', 'years' => '25', 'eid' => '', 'catalog_code' => 'HZNO04', 'company_code' => 'TEST' }, { 'browse' => 1, 'sequence_number' => '0', 'catalog_level' => 'C', 'years' => '5', 'eid' => '', 'catalog_code' => 'HZNO04', 'company_code' => 'TEST' } ], "offering level check - $db_type"); } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE offering_levels CASCADE'); $dbh->do('DROP TABLE offering_sequences CASCADE'); $dbh->do('DROP TABLE offerings CASCADE'); $dbh->do('DROP TABLE employee CASCADE'); $dbh->do('DROP TABLE employer CASCADE'); } my @sql = ( <<"EOF", CREATE OR REPLACE FUNCTION add_default_employee() RETURNS "trigger" AS ' BEGIN IF NEW.company_code IS NOT NULL THEN INSERT INTO employee (company_code, eid) VALUES ( NEW.company_code, '''' ); END IF; RETURN NEW; END; ' LANGUAGE 'plpgsql'; EOF <<"EOF", CREATE TABLE employer ( company_code VARCHAR(6) DEFAULT '' NOT NULL PRIMARY KEY, name VARCHAR(128) DEFAULT '' NOT NULL, data BYTEA ) EOF <<"EOF", CREATE TRIGGER employer_default_employee AFTER INSERT ON employer FOR EACH ROW EXECUTE PROCEDURE add_default_employee() EOF <<"EOF", CREATE TABLE employee ( company_code VARCHAR(6) DEFAULT '' NOT NULL, eid VARCHAR(9) DEFAULT '' NOT NULL, first_name VARCHAR(15) DEFAULT '' NOT NULL, last_name VARCHAR(25) DEFAULT '' NOT NULL, PRIMARY KEY (company_code, eid) ); EOF <<"EOF", ALTER TABLE employee ADD CONSTRAINT fk_employee_company_code FOREIGN KEY (company_code) REFERENCES employer(company_code) ON UPDATE CASCADE ON DELETE RESTRICT EOF <<"EOF", INSERT INTO employer (company_code, name) VALUES ('', 'Default Employer') EOF <<"EOF", CREATE TABLE offerings ( company_code VARCHAR(6) DEFAULT '' NOT NULL, eid VARCHAR(9) DEFAULT '' NOT NULL, years VARCHAR(2) DEFAULT '' NOT NULL, sort_order SMALLINT DEFAULT 0 NOT NULL, browse BOOLEAN DEFAULT true NOT NULL, discrete_sequences BOOLEAN DEFAULT true NOT NULL, PRIMARY KEY (company_code, eid, years) ) EOF <<"EOF", ALTER TABLE offerings ADD CONSTRAINT fk_offering_employee FOREIGN KEY (company_code, eid) REFERENCES employee(company_code, eid) ON UPDATE CASCADE ON DELETE CASCADE EOF <<"EOF", ALTER TABLE offerings ADD CONSTRAINT fk_offering_company_code FOREIGN KEY (company_code) REFERENCES employer(company_code) ON UPDATE CASCADE ON DELETE CASCADE EOF <<"EOF", INSERT INTO offerings (company_code, eid, years) VALUES ('','','05') EOF <<"EOF", INSERT INTO offerings (company_code, eid, years) VALUES ('','','10') EOF <<"EOF", INSERT INTO offerings (company_code, eid, years) VALUES ('','','15') EOF <<"EOF", CREATE TABLE offering_sequences ( company_code VARCHAR(6) DEFAULT '' NOT NULL, eid VARCHAR(9) DEFAULT '' NOT NULL, years VARCHAR(2) DEFAULT '' NOT NULL, sequence_number SMALLINT DEFAULT 0 NOT NULL, browse BOOLEAN DEFAULT true NOT NULL, PRIMARY KEY (company_code, eid, years, sequence_number) ) EOF <<"EOF", ALTER TABLE offering_sequences ADD CONSTRAINT fk_offering_sequences FOREIGN KEY (company_code, eid, years) REFERENCES offerings(company_code, eid, years) ON UPDATE CASCADE ON DELETE CASCADE EOF <<"EOF", INSERT INTO offering_sequences (company_code, eid, years, sequence_number) VALUES ('','','05',0) EOF <<"EOF", INSERT INTO offering_sequences (company_code, eid, years, sequence_number) VALUES ('','','10',0) EOF <<"EOF", INSERT INTO offering_sequences (company_code, eid, years, sequence_number) VALUES ('','','15',0) EOF <<"EOF", CREATE TABLE offering_levels ( company_code VARCHAR(6) DEFAULT '' NOT NULL, eid VARCHAR(9) DEFAULT '' NOT NULL, years VARCHAR(2) DEFAULT '' NOT NULL, sequence_number SMALLINT DEFAULT 0 NOT NULL, catalog_code VARCHAR(6) DEFAULT '' NOT NULL, catalog_level VARCHAR(2) DEFAULT '' NOT NULL, browse BOOLEAN DEFAULT true NOT NULL, PRIMARY KEY (company_code, eid, years, sequence_number, catalog_code, catalog_level) ) EOF <<"EOF", ALTER TABLE offering_levels ADD CONSTRAINT fk_offering_levels FOREIGN KEY (company_code, eid, years, sequence_number) REFERENCES offering_sequences(company_code, eid, years, sequence_number) ON UPDATE CASCADE ON DELETE CASCADE EOF ); foreach my $sql (@sql) { local $dbh->{'PrintError'} = 0; eval { $dbh->do($sql) }; if($@) { warn $@ unless($@ =~ /language "plpgsql" does not exist/); $Have{'pg'} = 0; $Have{'pg_with_schema'} = 0; last; } } $dbh->disconnect; } } END { # Delete test table if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE offering_levels CASCADE'); $dbh->do('DROP TABLE offering_sequences CASCADE'); $dbh->do('DROP TABLE offerings CASCADE'); $dbh->do('DROP TABLE employee CASCADE'); $dbh->do('DROP TABLE employer CASCADE'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/spot-check-11.t000755 000765 000120 00000004465 11653604702 017133 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 6; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Loader'); } our %Have; # # Tests # foreach my $db_type (qw(mysql)) { SKIP: { skip("$db_type tests", 4) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB->default_type($db_type); my $class_prefix = ucfirst($db_type); my $loader = Rose::DB::Object::Loader->new( db => Rose::DB->new, class_prefix => $class_prefix, include_tables => [ qw(users user_connections) ]); my @classes = $loader->make_classes; #foreach my $class (@classes) #{ # print $class->meta->perl_class_definition(braces => 'k&r', indent => 2) # if($class->can('meta')); #} my $user_connection_class = $class_prefix . '::UserConnection'; my @fks = sort { $a->name cmp $b->name } $user_connection_class->meta->foreign_keys; is_deeply(scalar $fks[0]->key_columns, { from_id => 'id' }, "fk 1.1 - $db_type"); is($fks[0]->name, 'from', "fk 1.2 - $db_type"); is_deeply(scalar $fks[1]->key_columns, { to_id => 'id' }, "fk 2.1 - $db_type"); is($fks[1]->name, 'to', "fk 2.2 - $db_type"); } BEGIN { our %Have; my $dbh; # # MySQL # if(have_db('mysql') && mysql_supports_innodb()) { $Have{'mysql'} = 1; $dbh = get_dbh('mysql_admin'); # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE user_connections'); $dbh->do('DROP TABLE users'); } $dbh->do(<<"EOF"); CREATE TABLE users ( id INT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ) ENGINE=InnoDB EOF $dbh->do(<<"EOF"); create table user_connections ( id INT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY, from_id INT UNSIGNED NOT NULL, to_id INT UNSIGNED NOT NULL, UNIQUE KEY (from_id, to_id), KEY (to_id), CONSTRAINT FOREIGN KEY (from_id) REFERENCES users (id), CONSTRAINT FOREIGN KEY (to_id) REFERENCES users (id) ) ENGINE=InnoDB; EOF $dbh->disconnect; } } END { # Delete test tables if($Have{'mysql'}) { my $dbh = get_dbh('mysql_admin'); $dbh->do('DROP TABLE user_connections'); $dbh->do('DROP TABLE users'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/spot-check-12.t000644 000765 000120 00000007120 11113677033 017116 0ustar00johnadmin000000 000000 #!/usr/bin/perl use strict; use Test::More tests => 10; require 't/test-lib.pl'; use Rose::DB::Object::Util qw(:children); use Rose::DB::Object::Constants qw(MODIFIED_COLUMNS); # # This test was created by Lucian Dragus # SKIP: { skip('sqlite tests', 10) unless(have_db('sqlite_admin')); Rose::DB->default_type('sqlite'); ### package Clients; use base 'Rose::DB::Object'; __PACKAGE__->meta->setup( table => 'clients', columns => [ id => { type => 'integer', not_null => 1 }, name => { type => 'varchar', not_null => 1 }, ], primary_key_columns => ['id'], helpers => 'load_or_save', helpers => { load_or_insert => 'find_or_create2' }, unique_key => ['name'], relationships => [ address => { class => 'Addresses', column_map => { id => 'client_id' }, type => 'one to one', }, ], ); sub init_db { Rose::DB->new } ### package Addresses; use base 'Rose::DB::Object'; __PACKAGE__->meta->setup( table => 'addresses', columns => [ id => { type => 'integer', not_null => 1 }, client_id => { type => 'integer', not_null => 1 }, street => { type => 'varchar' }, ], primary_key_columns => ['id'], unique_key => ['client_id'], helpers => [ 'load_or_save', { load_or_insert => 'find_or_create' } ], ###foreign_keys => [ ### client => { ### class => 'Clients', ### key_columns => { client_id => 'id' }, ### }, ###], ); sub init_db { Rose::DB->new } ### package main; { my $dbh = Rose::DB->new->retain_dbh(); { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE addresses'); $dbh->do('DROP TABLE clients'); } $dbh->do(<<"EOF"); CREATE TABLE clients ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR, UNIQUE(name) ) EOF $dbh->do(<<"EOF"); CREATE TABLE addresses ( id INTEGER PRIMARY KEY AUTOINCREMENT, client_id INT NOT NULL REFERENCES clients (id), street VARCHAR, UNIQUE(client_id) ) EOF $dbh->disconnect; } Clients->new( name => 'c1' )->save; ok(Addresses->can('load_or_save'), 'helpers 1'); ok(Addresses->can('find_or_create'), 'helpers 2'); ok(Clients->can('load_or_save'), 'helpers 3'); ok(Clients->can('find_or_create2'), 'helpers 4'); my $c = Clients->new( name => 'c1' ); $c->load; my $a = Addresses->new( client_id => $c->id, street => 's1' ); $c->address($a); #$Rose::DB::Object::Debug = 1; #$Rose::DB::Object::Manager::Debug = 1; ok($c->save( cascade => 1, changes_only => 1 ), 'save cascade changes only'); $c = Rose::DB::Object::Manager->get_objects( object_class => 'Clients', with_objects => 'address')->[0]; ok(!keys %{ $c->{MODIFIED_COLUMNS()} || {} }, 'check modified columns'); ok(has_loaded_related($c, 'address'), 'has_loaded_related() 1'); ok(has_loaded_related(object => $c, relationship => 'address'), 'has_loaded_related() 2'); $c->address->street('s2'); ok($c->save(cascade => 1, changes_only => 1), 'save cascade changes only - loaded with Manager'); $a = Addresses->new(id => $a->id)->load; is($a->street, 's2', 'save cascade changes only - check'); } END { if(have_db('sqlite_admin')) { my $dbh = get_dbh('sqlite_admin'); local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE addresses'); $dbh->do('DROP TABLE clients'); } } Rose-DB-Object-0.810/t/spot-check-13.t000644 000765 000120 00000005507 11113677033 017126 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 2; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); } our %Have; # # Test created by Jud # foreach my $db_type (qw(pg)) { SKIP: { skip("$db_type tests", 1) unless($Have{$db_type}); } next unless($Have{$db_type}); my $t1 = T1->new(id => 1)->save; my $t2 = T2->new(id => 1)->save; my $tt = T1T2Map->new; $tt->t1_id(1); $tt->t2_id(1); $tt->save; my @results = $t2->t1s; is(scalar @results, 1, "bigint keys - $db_type"); } BEGIN { our %Have; # # Pg # my $dbh; eval { my $db = Rose::DB->new('pg_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE t1_t2_map'); $dbh->do('DROP TABLE t1'); $dbh->do('DROP TABLE t2'); } }; if(!$@ && $dbh) { $Have{'pg'} = 1; $dbh->do(<<"EOF"); CREATE TABLE t1 ( id BIGINT NOT NULL PRIMARY KEY ) EOF $dbh->do(<<"EOF"); CREATE TABLE t2 ( id BIGINT NOT NULL PRIMARY KEY ) EOF $dbh->do(<<"EOF"); CREATE TABLE t1_t2_map ( t1_id BIGINT NOT NULL, t2_id BIGINT NOT NULL, PRIMARY KEY(t1_id, t2_id) ) EOF $dbh->disconnect; Rose::DB->default_type('pg'); package T1; our @ISA = qw(Rose::DB::Object); __PACKAGE__->meta->setup ( table => 't1', columns => [ id => { type => 'bigint', not_null => 1, primary_key => 1 }, ], relationships => [ related => { type => 'many to many', map_class => 'T1T2Map', map_from => 't1', map_to => 't2', }, ], ); package T1T2Map; our @ISA = qw(Rose::DB::Object); __PACKAGE__->meta->setup ( table => 't1_t2_map', columns => [ t1_id => { type => 'bigint', not_null => 1 }, t2_id => { type => 'bigint', not_null => 1 }, ], primary_key_columns => ['t1_id', 't2_id'], foreign_keys => [ t1 => { class => 'T1' }, t2 => { class => 'T2' }, ], ); package T2; our @ISA = qw(Rose::DB::Object); __PACKAGE__->meta->setup ( table => 't2', columns => [ id => { type => 'bigint', not_null => 1, primary_key => 1 }, ], relationships => [ t1s => { type => 'many to many', map_class => 'T1T2Map', column_map => { node_id => 'id' }, }, ], ); } } END { # Delete test tables if($Have{'pg'}) { my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE t1_t2_map'); $dbh->do('DROP TABLE t1'); $dbh->do('DROP TABLE t2'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/spot-check-14.t000644 000765 000120 00000004731 11264234563 017131 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 2 + 6; BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); use_ok('Rose::DB::Object::Loader'); } our %Have; foreach my $db_type (qw(pg)) { SKIP: { skip("$db_type tests", 6) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB::Object::Metadata->unregister_all_classes; Rose::DB->default_type($db_type); my $class_prefix = ucfirst($db_type); my $loader = Rose::DB::Object::Loader->new( db => Rose::DB->new, class_prefix => $class_prefix); my @classes = $loader->make_classes(include_tables => [ qw(rdbo_users rdbo_comments) ]); #foreach my $class (@classes) #{ # print $class->meta->perl_class_definition if($class->can('meta')); #} my $user_class = $class_prefix . '::RdboUser'; my $comment_class = $class_prefix . '::RdboComment'; ok($user_class->meta->relationship('user1s'), "user1s rel - $db_type"); ok($user_class->meta->relationship('user2s'), "user2s rel - $db_type"); ok($comment_class->meta->foreign_key('user1'), "user1 fk - $db_type"); ok($comment_class->meta->foreign_key('user2'), "user2 fk - $db_type"); is($comment_class->meta->column('type')->type, 'enum', "enum - $db_type"); is($comment_class->meta->column('type')->db_type, 'my_type', "custom type - $db_type"); } BEGIN { our %Have; # # Pg # my $dbh; eval { my $db = Rose::DB->new('pg_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rdbo_comments'); $dbh->do('DROP TABLE rdbo_users'); $dbh->do('DROP TYPE my_type'); } }; if(!$@ && $dbh) { $Have{'pg'} = 1; $dbh->do(<<"EOF"); CREATE TABLE rdbo_users ( id INT NOT NULL PRIMARY KEY ) EOF $dbh->do(<<"EOF"); CREATE TYPE my_type AS ENUM ('foo', 'bar') EOF $dbh->do(<<"EOF"); CREATE TABLE rdbo_comments ( id SERIAL NOT NULL PRIMARY KEY, user1_id INTEGER NOT NULL REFERENCES rdbo_users (id), user2_id INTEGER NOT NULL REFERENCES rdbo_users (id), type MY_TYPE ) EOF $dbh->disconnect; } } END { # Delete test tables if($Have{'pg'}) { my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rdbo_comments'); $dbh->do('DROP TABLE rdbo_users'); $dbh->do('DROP TYPE my_type'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/test-lib.pl000755 000765 000120 00000021331 11653604702 016536 0ustar00johnadmin000000 000000 #!/usr/bin/perl use strict; use FindBin qw($Bin); use Rose::DB; BEGIN { Rose::DB->default_domain('test'); # # PostgreSQL # eval { require DBD::Pg }; $ENV{'PGDATESTYLE'} = 'MDY'; no warnings 'uninitialized'; # Many tests don't work with DBD::Pg version 2.1.x and 2.2.0 unless($DBD::Pg::VERSION =~ /^2\.(?:1\.|2\.0)/) { # Main Rose::DB->register_db( domain => 'test', type => 'pg', driver => 'Pg', database => 'test', host => 'localhost', username => 'postgres', password => '', connect_options => { AutoCommit => 1 }, post_connect_sql => [ 'SET default_transaction_isolation TO "read committed"', ], ); # Private schema Rose::DB->register_db( domain => 'test', type => 'pg_with_schema', schema => 'rose_db_object_private', driver => 'Pg', database => 'test', host => 'localhost', username => 'postgres', password => '', connect_options => { AutoCommit => 1 }, post_connect_sql => [ 'SET default_transaction_isolation TO "read committed"', ], ); # Admin Rose::DB->register_db( domain => 'test', type => 'pg_admin', driver => 'Pg', database => 'test', host => 'localhost', username => 'postgres', password => '', connect_options => { AutoCommit => 1 }, post_connect_sql => [ 'SET default_transaction_isolation TO "read committed"', ], ); } # # MySQL # # Main Rose::DB->register_db( domain => 'test', type => 'mysql', driver => 'mysql', database => 'test', host => 'localhost', username => 'root', password => '' ); # Admin Rose::DB->register_db( domain => 'test', type => 'mysql_admin', driver => 'mysql', database => 'test', host => 'localhost', username => 'root', password => '' ); # # Informix # # Main Rose::DB->register_db( domain => 'test', type => 'informix', driver => 'Informix', database => 'test@test', connect_options => { AutoCommit => 1 }, post_connect_sql => [ 'SET LOCK MODE TO WAIT 100', 'SET ISOLATION TO DIRTY READ', ], ); # Admin Rose::DB->register_db( domain => 'test', type => 'informix_admin', driver => 'Informix', database => 'test@test', connect_options => { AutoCommit => 1 }, post_connect_sql => [ 'SET LOCK MODE TO WAIT 100', 'SET ISOLATION TO DIRTY READ', ], ); # # SQLite # eval { local $^W = 0; require DBD::SQLite; }; (my $version = $DBD::SQLite::VERSION || 0) =~ s/_//g; unless($ENV{'RDBO_NO_SQLITE'} || $version < 1.11 || ($version >= 1.13 && $version < 1.1902)) { #unlink("$Bin/sqlite.db"); # Main Rose::DB->register_db( domain => 'test', type => 'sqlite', driver => 'sqlite', database => "$Bin/sqlite.db", auto_create => 0, connect_options => { AutoCommit => 1 }, post_connect_sql => [ 'PRAGMA synchronous = OFF', 'PRAGMA temp_store = MEMORY', ], ); # Admin Rose::DB->register_db( domain => 'test', type => 'sqlite_admin', driver => 'sqlite', database => "$Bin/sqlite.db", connect_options => { AutoCommit => 1 }, post_connect_sql => [ 'PRAGMA synchronous = OFF', 'PRAGMA temp_store = MEMORY', ], ); } # # Oracle # # Main Rose::DB->register_db( domain => 'test', type => 'oracle', driver => 'oracle', database => 'test@test', connect_options => { AutoCommit => 1 }, ); # Admin Rose::DB->register_db( domain => 'test', type => 'oracle_admin', driver => 'oracle', database => 'test@test', connect_options => { AutoCommit => 1 }, ); my @types = qw(pg pg_with_schema pg_admin mysql mysql_admin informix informix_admin oracle oracle_admin); unless($Rose::DB::Object::Test::NoDefaults) { foreach my $db_type (qw(PG MYSQL INFORMIX ORACLE)) { if(my $dsn = $ENV{"RDBO_${db_type}_DSN"}) { foreach my $type (grep { /^$db_type(?:_|$)/i } @types) { Rose::DB->modify_db(domain => 'test', type => $type, dsn => $dsn); } } if(my $user = $ENV{"RDBO_${db_type}_USER"}) { foreach my $type (grep { /^$db_type(?:_|$)/i } @types) { Rose::DB->modify_db(domain => 'test', type => $type, username => $user); } } if(my $user = $ENV{"RDBO_${db_type}_PASS"}) { foreach my $type (grep { /^$db_type(?:_|$)/i } @types) { Rose::DB->modify_db(domain => 'test', type => $type, password => $user); } } } } } package main; my %Have_DB; sub get_db { my($type) = shift; if((defined $Have_DB{$type} && !$Have_DB{$type}) || !get_dbh($type)) { return undef; } return Rose::DB->new($type); } sub get_dbh { my($type) = shift; my $dbh; local $@; eval { $dbh = Rose::DB->new($type)->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have_DB{$type} = 1; return $dbh; } return $Have_DB{$type} = 0; } sub have_db { my($type) = shift; if($type =~ /^sqlite(?:_admin)$/ && $ENV{'RDBO_NO_SQLITE'}) { return $Have_DB{$type} = 0; } return $Have_DB{$type} = shift if(@_); return $Have_DB{$type} if(exists $Have_DB{$type}); return get_dbh($type) ? 1 : 0; } sub mysql_supports_innodb { my $db = get_db('mysql_admin') or return 0; eval { my $dbh = $db->dbh; CLEAR: { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rdbo_innodb_test'); } $dbh->do(<<"EOF"); CREATE TABLE rdbo_innodb_test ( id INTEGER PRIMARY KEY ) ENGINE=InnoDB EOF # MySQL will silently ignore the "ENGINE=InnoDB" part and create # a MyISAM table instead. MySQL is evil! Now we have to manually # check to make sure an InnoDB table was really created. my $db_name = $db->database; my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?"); $sth->execute('rdbo_innodb_test'); my $info = $sth->fetchrow_hashref; no warnings 'uninitialized'; unless(lc $info->{'Type'} eq 'innodb' || lc $info->{'Engine'} eq 'innodb') { die "Missing InnoDB support"; } $dbh->do('DROP TABLE rdbo_innodb_test'); }; if($@) { warn $@ unless($@ =~ /Missing InnoDB support/); return 0; } return 1; } our $PG_HAS_CHKPASS = $ENV{'PG_HAS_CHKPASS'}; sub pg_has_chkpass { return $PG_HAS_CHKPASS if(defined $PG_HAS_CHKPASS); my $dbh = get_dbh('pg_admin') or return undef; eval { local $dbh->{'RaiseError'} = 1; local $dbh->{'PrintError'} = 0; $dbh->do('CREATE TABLE rose_db_object_chkpass_test (pass CHKPASS)'); $dbh->do('DROP TABLE rose_db_object_chkpass_test'); }; return $PG_HAS_CHKPASS = $@ ? 0 : 1; } our $PG_MAX_CONNECTIONS; sub pg_max_connections { return $PG_MAX_CONNECTIONS if(defined $PG_MAX_CONNECTIONS); my $dbh = get_dbh('pg') or return 0; my @dbh = ($dbh); for(;;) { eval { $dbh = get_dbh('pg') or die; push(@dbh, $dbh) }; last if($@ || @dbh > 50); } return $PG_MAX_CONNECTIONS = @dbh; } sub oracle_is_broken { return undef unless(have_db('oracle')); my $db = get_db('oracle'); # This particular version of Oracle 10g on Mac OS X is broken return ($db->database_version == 100010300 && $^O =~ /darwin/i) ? 1 : 0; } our $HAVE_TEST_MEMORY_CYCLE; eval { require Test::Memory::Cycle; $HAVE_TEST_MEMORY_CYCLE = 1; }; sub test_memory_cycle_ok { my($val, $msg) = @_; $HAVE_TEST_MEMORY_CYCLE ? Test::Memory::Cycle::memory_cycle_ok($val, $msg) : Test::More::ok(1, "$msg (skipped)"); } my %Column_Args = ( enum => [ values => [ 'a' .. 'z' ] ], ); sub nonpersistent_column_definitions { my @columns; my $i = 1; foreach my $type (Rose::DB::Object::Metadata->column_type_names) { next if($type =~ /(?:chkpass| to |serial|array|\bset\b)/); push(@columns, 'np' . $i++ => { type => $type, smart_modification => 0, temp => 1, @{ $Column_Args{$type} || [] } }); } return @columns; } sub modify_nonpersistent_column_values { my($object) = shift; foreach my $column ($object->meta->nonpersistent_columns) { my $method = $column->mutator_method_name; $object->$method(undef); # with smart modification off, this should be sufficient } } sub add_nonpersistent_columns_and_methods { my($class) = shift; my $meta = $class->meta; $meta->add_columns(nonpersistent_column_definitions()); $meta->make_nonpersistent_column_methods(); } 1; Rose-DB-Object-0.810/t/undef-overrides-default.t000644 000765 000120 00000020115 12011207053 021345 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; require Test::More; require 't/test-lib.pl'; if(have_db('sqlite_admin')) { Test::More->import(tests => 1523); #Test::More->import('no_plan'); } else { Test::More->import(skip_all => 'No SQLite'); } use_ok('DateTime'); use_ok('DateTime::Duration'); use_ok('Time::Clock'); use_ok('Bit::Vector'); use_ok('Rose::DB::Object'); package My::DB::Object; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } My::DB::Object->meta->table('rose_db_object_nonesuch'); package My::DB::Object::USN; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } My::DB::Object::USN->meta->table('rose_db_object_nonesuch'); package My::DB::Object::USN::Default; our @ISA = qw(Rose::DB::Object); sub init_db { Rose::DB->new('sqlite') } My::DB::Object::USN::Default->meta->table('rose_db_object_nonesuch'); My::DB::Object::USN::Default->meta->column_undef_overrides_default(1); package main; use Rose::DB::Object::Util qw(is_in_db set_state_in_db unset_state_in_db); my $classes = My::DB::Object->meta->column_type_classes; my $meta = My::DB::Object->meta; my $meta_usn = My::DB::Object::USN->meta; my $meta_usnd = My::DB::Object::USN::Default->meta; my $DT = DateTime->new(year => 2007, month => 12, day => 31); my $Time = Time::Clock->new('12:34:56'); my $Dur = DateTime::Duration->new(years => 3); my $Set = [ 1, 2, 3 ]; my $Array = [ 4, 5, 6 ]; my $BV = Bit::Vector->new_Dec(32, 123); my $DT2 = DateTime->new(year => 2008, month => 12, day => 31); my $Time2 = Time::Clock->new('22:34:56'); my $Dur2 = DateTime::Duration->new(years => 5); my $Set2 = [ 7, 8, 9 ]; my $Array2 = [ 9, 8, 7 ]; my $BV2 = Bit::Vector->new_Dec(32, 456); my %extra = ( enum => { values => [ 'foo', 'bar' ] }, ); my $i = 0; foreach my $type (sort keys (%$classes)) { $i++; my $default = default_for_column_type($type); my %e = $extra{$type} ? %{$extra{$type}} : (); $e{'add_method_types'} = [ qw(get) ]; $meta->add_column("c$i" => { type => $type, default => $default, %e }); $meta_usn->add_column("c$i" => { type => $type, default => $default, undef_overrides_default => 1, %e }); $meta_usnd->add_column("c$i" => { type => $type, default => $default, %e }); } $meta->initialize; $meta_usn->initialize; $meta_usnd->initialize; foreach my $n (1 .. $i) { my $col = "c$n"; my $type = $meta->column($col)->type; my $default = $meta->column($col)->default; my $method_base = method_for_column_type($type, $n); my $db = db_for_column_type($meta->column($col)->type); unless($db) { SKIP: { skip("db unavailable for $type tests", 15); } next; } foreach my $method ($method_base, ($type eq 'chkpass' ? () : "get_$method_base")) { my $o = My::DB::Object->new; my $o_usn = My::DB::Object::USN->new; my $o_usnd = My::DB::Object::USN::Default->new; $o->db($db); $o_usn->db($db); $o_usnd->db($db); set_state_in_db($o); set_state_in_db($o_usn); set_state_in_db($o_usnd); is(massage_value(scalar $o->$method()), massage_value($default), "$method $type in db default $n"); is(massage_value(scalar $o_usn->$method()), undef, "$method $type in db undef USN explicit $n"); is(massage_value(scalar $o_usnd->$method()), undef, "$method $type in db undef USN default $n"); unset_state_in_db($o); unset_state_in_db($o_usn); unset_state_in_db($o_usnd); is(massage_value(scalar $o->$method()), massage_value($default), "$method $type default $n"); is(massage_value(scalar $o_usn->$method()), massage_value($default), "$method $type USN explicit $n"); is(massage_value(scalar $o_usnd->$method()), massage_value($default), "$method type USN default $n"); $o->$method_base(undef); $o_usn->$method_base(undef); $o_usnd->$method_base(undef); is(massage_value(scalar $o->$method()), massage_value($default), "$method $type undef default $n"); is(massage_value(scalar $o_usn->$method()), undef, "$method $type undef USN explicit $n"); is(massage_value(scalar $o_usnd->$method()), undef, "$method $type undef USN default $n"); my $value = value_for_column_type($type); $o->$method_base($value); $o_usn->$method_base($value); $o_usnd->$method_base($value); is(massage_value(scalar $o->$method()), massage_value($value), "$method $type value default $n"); is(massage_value(scalar $o_usn->$method()), massage_value($value), "$method $type value USN explicit $n"); is(massage_value(scalar $o_usnd->$method()), massage_value($value), "$method $type value USN default $n"); $o->$method_base(undef); $o_usn->$method_base(undef); $o_usnd->$method_base(undef); is(massage_value(scalar $o->$method()), massage_value($default), "$method $type undef default $n"); is(massage_value(scalar $o_usn->$method()), undef, "$method $type undef USN explicit $n"); is(massage_value(scalar $o_usnd->$method()), undef, "$method $type undef USN default $n"); } } # Default true or nonexistent undef_overrides_default attribute does # not conflict with true not_null attribute My::DB::Object->meta->add_column('nn' => { type => 'scalar', not_null => 1 }); My::DB::Object->meta->initialize(replace_existing => 1); My::DB::Object::USN->meta->add_column('nn' => { type => 'scalar', not_null => 1 }); My::DB::Object::USN->meta->initialize(replace_existing => 1); My::DB::Object::USN::Default->meta->add_column('nn' => { type => 'scalar', not_null => 1 }); My::DB::Object::USN::Default->meta->initialize(replace_existing => 1); # Explicit true undef_overrides_default attribute conflicts with true not_null attribute My::DB::Object->meta->add_column('nn' => { type => 'scalar', not_null => 1, undef_overrides_default => 1 }); eval { My::DB::Object->meta->initialize(replace_existing => 1) }; ok($@, 'not_null undef_overrides_default conflict 1'); My::DB::Object::USN->meta->add_column('nn' => { type => 'scalar', not_null => 1, undef_overrides_default => 1 }); eval { My::DB::Object::USN->meta->initialize(replace_existing => 1) }; ok($@, 'not_null undef_overrides_default conflict 2'); My::DB::Object::USN::Default->meta->add_column('nn' => { type => 'scalar', not_null => 1, undef_overrides_default => 1}); eval { My::DB::Object::USN::Default->meta->initialize(replace_existing => 1) }; ok($@, 'not_null undef_overrides_default conflict 3'); sub massage_value { my($value) = shift; if(ref $value eq 'ARRAY') { return "@$value"; } return undef unless(defined $value); # XXX: Trim off leading + sign that some versions of Math::BigInt seem to add $value =~ s/^\+//; return "$value"; } my %DB; sub db_for_column_type { my($type) = shift; if($type =~ / year to |^set$/) { return $DB{'informix'} ||= Rose::DB->new('informix'); } elsif($type =~ /^(?:interval|chkpass)$/) { return $DB{'pg'} ||= Rose::DB->new('pg'); } else { return $DB{'sqlite'} ||= Rose::DB->new('sqlite'); } } sub method_for_column_type { my($type, $i) = @_; if($type eq 'chkpass') { return "c${i}_encrypted"; } return "c$i"; } sub default_for_column_type { my($type) = shift; if($type =~ /date|timestamp|epoch/) { return $DT; } elsif($type eq 'time') { return $Time; } elsif($type eq 'interval') { return $Dur; } elsif($type eq 'enum') { return 'foo'; } elsif($type eq 'set') { return $Set; } elsif($type eq 'array') { return $Array; } elsif($type =~ /^(?:bitfield|bits)/) { return $BV; } elsif($type =~ /^bool/) { return 1; } elsif($type eq 'chkpass') { return ':vOR7BujbRZSLM'; } return 123; } sub value_for_column_type { my($type) = shift; if($type =~ /date|timestamp|epoch/) { return $DT2; } elsif($type eq 'time') { return $Time2; } elsif($type eq 'interval') { return $Dur2; } elsif($type eq 'enum') { return 'bar'; } elsif($type eq 'set') { return $Set2; } elsif($type eq 'array') { return $Array2; } elsif($type =~ /^(?:bitfield|bits)/) { return $BV2; } elsif($type =~ /^bool/) { return 0; } elsif($type eq 'chkpass') { return ':vOR7BujbRZSLP'; } return 456; }Rose-DB-Object-0.810/t/unique-key-prefs.t000755 000765 000120 00000010305 11225465612 020053 0ustar00johnadmin000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 1 + (1 * 4); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object::Loader'); } our %Have; # # Tests # #$Rose::DB::Object::Manager::Debug = 1; foreach my $db_type (qw(mysql pg informix sqlite)) { SKIP: { skip("$db_type tests", 1) unless($Have{$db_type}); } next unless($Have{$db_type}); Rose::DB::Object::Metadata->unregister_all_classes; Rose::DB->default_type($db_type); my $class_prefix = ucfirst($db_type); my $loader = Rose::DB::Object::Loader->new( db => Rose::DB->new, class_prefix => $class_prefix); my @classes = $loader->make_classes(include_tables => [ 'rose_db_object_uk_test' ]); #foreach my $class (@classes) #{ # print $class->meta->perl_class_definition if($class->can('meta')); #} my $class = $class_prefix . '::RoseDbObjectUkTest'; $class->new(a => 1, b => 2, c => 3)->save; my $o = $class->new(a => 1, c => 3); ok($o->load(speculative => 1), "unique key precedence 1 - $db_type"); } BEGIN { our %Have; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'pg'} = 1; $Have{'pg_with_schema'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_uk_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_uk_test ( id SERIAL NOT NULL PRIMARY KEY, a INT, b INT, c INT, UNIQUE(a, b, c), UNIQUE(a, c) ) EOF $dbh->disconnect; } # # MySQL # eval { my $db = Rose::DB->new('mysql_admin'); $dbh = $db->retain_dbh or die Rose::DB->error; # Drop existing tables, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_uk_test'); } }; if(!$@ && $dbh) { $Have{'mysql'} = 1; $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_uk_test ( id INT AUTO_INCREMENT PRIMARY KEY, a INT, b INT, c INT, UNIQUE(a, b, c), UNIQUE(a, c) ) EOF $dbh->disconnect; } # # Informix # eval { $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'informix'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_uk_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_uk_test ( id SERIAL NOT NULL PRIMARY KEY, a INT, b INT, c INT, UNIQUE(a, b, c), UNIQUE(a, c) ) EOF $dbh->disconnect; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have{'sqlite'} = 1; # Drop existing tables and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_uk_test'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_uk_test ( id INTEGER PRIMARY KEY AUTOINCREMENT, a INT, b INT, c INT, UNIQUE(a, b, c), UNIQUE(a, c) ) EOF $dbh->disconnect; } } END { # Delete test table if($Have{'pg'}) { # PostgreSQL my $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_uk_test'); $dbh->disconnect; } if($Have{'mysql'}) { # MySQL my $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_uk_test'); $dbh->disconnect; } if($Have{'informix'}) { # Informix my $dbh = Rose::DB->new('informix_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_uk_test'); $dbh->disconnect; } if($Have{'sqlite'}) { # Informix my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_uk_test'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/sandbox/code-gen/000750 000765 000120 00000000000 12266514755 017576 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/sandbox/convention/000750 000765 000120 00000000000 12266514755 020277 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/sandbox/schema-clash/000750 000765 000120 00000000000 12266514755 020445 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/sandbox/schema-clash/lib/000750 000765 000120 00000000000 12266514755 021213 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/sandbox/schema-clash/sql/000750 000765 000120 00000000000 12266514755 021244 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/sandbox/schema-clash/t/000750 000765 000120 00000000000 12266514755 020710 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/sandbox/schema-clash/test.pl000755 000765 000120 00000000536 11113677033 021762 0ustar00johnadmin000000 000000 #!/usr/bin/perl use FindBin qw($Bin); chdir($Bin) or die "Could not chdir($Bin) - $!"; use lib "$Bin/../../../lib"; use lib "$Bin/../../../../Rose-DB/lib"; use lib "$Bin/lib"; system(qw(/usr/bin/perl -I ../../../lib -I ../../../../Rose-DB/lib -I lib t/one.t)); system(qw(/usr/bin/perl -I ../../../lib -I ../../../../Rose-DB/lib -I lib t/two.t)); Rose-DB-Object-0.810/t/sandbox/schema-clash/t/one.t000644 000765 000120 00000000251 11113677033 021646 0ustar00johnadmin000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More tests => 1; use Alpha; use Beta; ok( Alpha::Member->can( 'friends' ), 'Alpha::Member has friends method' ); Rose-DB-Object-0.810/t/sandbox/schema-clash/t/two.t000644 000765 000120 00000000432 11113677033 021677 0ustar00johnadmin000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More tests => 1; use Beta; use Alpha; #print Beta::Member->meta->perl_class_definition, "\n", # Alpha::Member->meta->perl_class_definition, "\n"; ok( Alpha::Member->can( 'friends' ), 'Alpha::Member has friends method' ); Rose-DB-Object-0.810/t/sandbox/schema-clash/sql/alpha.sql000644 000765 000120 00000001003 11113677033 023036 0ustar00johnadmin000000 000000 DROP TABLE IF EXISTS friends; DROP TABLE IF EXISTS members; CREATE TABLE members ( id INT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY, user VARCHAR(255) NOT NULL, UNIQUE ( user ) ) TYPE = InnoDB; CREATE TABLE friends ( id INT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY, member_id INT UNSIGNED NOT NULL, reference VARCHAR(255) NOT NULL, FOREIGN KEY ( member_id ) REFERENCES members ( id ) ON DELETE CASCADE ) Engine = InnoDB; Rose-DB-Object-0.810/t/sandbox/schema-clash/sql/beta.sql000644 000765 000120 00000000321 11113677033 022666 0ustar00johnadmin000000 000000 DROP TABLE IF EXISTS members; CREATE TABLE members ( id INT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY, email VARCHAR(255) NOT NULL, UNIQUE ( email ) ) TYPE = InnoDB; Rose-DB-Object-0.810/t/sandbox/schema-clash/sql/databases.sql000644 000765 000120 00000000452 11113677033 023707 0ustar00johnadmin000000 000000 drop database if exists alpha; drop database if exists beta; create database alpha; create database beta; grant all privileges on alpha.* to 'alpha'@'localhost' identified by 'alphapass'; grant all privileges on beta.* to 'beta'@'localhost' identified by 'betapass'; flush privileges; Rose-DB-Object-0.810/t/sandbox/schema-clash/lib/Alpha.pm000644 000765 000120 00000001213 11113677033 022565 0ustar00johnadmin000000 000000 #! /usr/bin/perl use strict; use warnings FATAL => 'all'; package Alpha; { package Alpha::DB; use base qw( Rose::DB ); __PACKAGE__->use_private_registry; __PACKAGE__->default_type( 'main' ); __PACKAGE__->default_domain( 'test' ); __PACKAGE__->register_db( domain => 'test', type => 'main', driver => 'mysql', host => 'localhost', database => 'alpha', username => 'alpha', password => 'alphapass', ); } use Rose::DB::Object::Loader; Rose::DB::Object::Loader->new( db => Alpha::DB->new, class_prefix => "Alpha::", )->make_classes; 1; Rose-DB-Object-0.810/t/sandbox/schema-clash/lib/Beta.pm000644 000765 000120 00000001204 11113677033 022413 0ustar00johnadmin000000 000000 #! /usr/bin/perl use strict; use warnings FATAL => 'all'; package Beta; { package Beta::DB; use base qw( Rose::DB ); __PACKAGE__->use_private_registry; __PACKAGE__->default_type( 'main' ); __PACKAGE__->default_domain( 'test' ); __PACKAGE__->register_db( domain => 'test', type => 'main', driver => 'mysql', host => 'localhost', database => 'beta', username => 'beta', password => 'betapass', ); } use Rose::DB::Object::Loader; Rose::DB::Object::Loader->new( db => Beta::DB->new, class_prefix => "Beta::", )->make_classes; 1; Rose-DB-Object-0.810/t/sandbox/convention/convention-test-auto.pl000755 000765 000120 00000005577 11113677033 024754 0ustar00johnadmin000000 000000 #!/usr/bin/perl use lib '../../../lib'; use lib 'lib'; use My::Auto::Price; use My::Auto::Product; use My::Auto::ProductColors; # use My::Auto::Price; # use My::Auto::Color; # use My::Auto::Vendor; # $p = My::Auto::Product->new(id => 1, name => 'A'); # $p->prices(My::Auto::Price->new(product_id => 1, region => 'IS', price => 1.23), # My::Auto::Price->new(product_id => 1, region => 'DE', price => 4.56)); # # $p->colors(My::Auto::Color->new(code => 'CC1', name => 'red'), # My::Auto::Color->new(code => 'CC2', name => 'green')); # # $p->vendor(My::Auto::Vendor->new(id => 1, name => 'V1')); # $p->save; $p = My::Auto::Product->new(id => 1)->load; print $p->vendor->name, "\n"; print join(', ', map { $_->region . ': ' . $_->price } $p->prices), "\n"; print join(', ', map { $_->name } $p->colors), "\n"; __END__ DROP TABLE product_colors CASCADE; DROP TABLE prices CASCADE; DROP TABLE products CASCADE; DROP TABLE colors CASCADE; DROP TABLE vendors CASCADE; CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) ); CREATE TABLE colors ( code CHAR(3) NOT NULL PRIMARY KEY, name VARCHAR(255) ); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255), vendor_id INT NOT NULL REFERENCES vendors (id), UNIQUE(name) ); CREATE TABLE prices ( price_id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL ); CREATE TABLE product_colors ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), color_code CHAR(3) NOT NULL REFERENCES colors (code) ); INSERT INTO vendors (id, name) VALUES (1, 'V1'); INSERT INTO vendors (id, name) VALUES (2, 'V2'); INSERT INTO products (id, name, vendor_id) VALUES (1, 'A', 1); INSERT INTO products (id, name, vendor_id) VALUES (2, 'B', 2); INSERT INTO products (id, name, vendor_id) VALUES (3, 'C', 1); INSERT INTO prices (product_id, region, price) VALUES (1, 'US', 1.23); INSERT INTO prices (product_id, region, price) VALUES (1, 'DE', 4.56); INSERT INTO prices (product_id, region, price) VALUES (2, 'US', 5.55); INSERT INTO prices (product_id, region, price) VALUES (3, 'US', 5.78); INSERT INTO prices (product_id, region, price) VALUES (3, 'US', 9.99); INSERT INTO colors (code, name) VALUES ('CC1', 'red'); INSERT INTO colors (code, name) VALUES ('CC2', 'green'); INSERT INTO colors (code, name) VALUES ('CC3', 'blue'); INSERT INTO colors (code, name) VALUES ('CC4', 'pink'); INSERT INTO product_colors (product_id, color_code) VALUES (1, 'CC1'); INSERT INTO product_colors (product_id, color_code) VALUES (1, 'CC2'); INSERT INTO product_colors (product_id, color_code) VALUES (2, 'CC4'); INSERT INTO product_colors (product_id, color_code) VALUES (3, 'CC2'); INSERT INTO product_colors (product_id, color_code) VALUES (3, 'CC3'); Rose-DB-Object-0.810/t/sandbox/convention/convention-test-loader.pl000755 000765 000120 00000006600 11113677033 025236 0ustar00johnadmin000000 000000 #!/usr/bin/perl use lib '../../../lib'; use lib 'lib'; use My::DB; use Rose::DB::Object::Loader; my $include_tables = '^(?:' . join('|', qw(product_colors prices products colors vendors)) . ')$'; my $loader = Rose::DB::Object::Loader->new; $loader->make_classes(include_tables => $include_tables, class_prefix => 'My::Loaded', #with_foreign_keys => 0, #with_unique_keys => 0, #with_relationships => [ 'one to many', 'many to many' ], #db_class => 'My::DB2', #db => My::DB->new db_class => 'My::DB'); #print 'FK: ', My::Loaded::Product->meta->foreign_keys, "\n"; #print 'UK: ', My::Loaded::Product->meta->unique_keys, "\n"; $p = My::Loaded::Product->new(id => 1)->load; print $p->vendor->name, "\n"; print join(', ', map { $_->region . ': ' . $_->price } $p->prices), "\n"; print join(', ', map { $_->name } $p->colors), "\n"; # Testing subselect limit #local $Rose::DB::Object::Manager::Debug = 1; my $ps = My::Loaded::Product::Manager->get_products( with_objects => [ 'prices' ], require_objects => [ 'vendor', 'colors' ], multi_many_ok => 1, query => [ 't1.id' => { lt => 999 }, 'prices.price' => 9 ], limit => 1, offset => 1); __END__ DROP TABLE product_colors CASCADE; DROP TABLE prices CASCADE; DROP TABLE products CASCADE; DROP TABLE colors CASCADE; DROP TABLE vendors CASCADE; CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) ); CREATE TABLE colors ( code CHAR(3) NOT NULL PRIMARY KEY, name VARCHAR(255) ); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255), vendor_id INT NOT NULL REFERENCES vendors (id), UNIQUE(name) ); CREATE TABLE prices ( price_id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL ); CREATE TABLE product_colors ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), color_code CHAR(3) NOT NULL REFERENCES colors (code) ); INSERT INTO vendors (id, name) VALUES (1, 'V1'); INSERT INTO vendors (id, name) VALUES (2, 'V2'); INSERT INTO products (id, name, vendor_id) VALUES (1, 'A', 1); INSERT INTO products (id, name, vendor_id) VALUES (2, 'B', 2); INSERT INTO products (id, name, vendor_id) VALUES (3, 'C', 1); INSERT INTO prices (product_id, region, price) VALUES (1, 'US', 1.23); INSERT INTO prices (product_id, region, price) VALUES (1, 'DE', 4.56); INSERT INTO prices (product_id, region, price) VALUES (2, 'US', 5.55); INSERT INTO prices (product_id, region, price) VALUES (3, 'US', 5.78); INSERT INTO prices (product_id, region, price) VALUES (3, 'US', 9.99); INSERT INTO colors (code, name) VALUES ('CC1', 'red'); INSERT INTO colors (code, name) VALUES ('CC2', 'green'); INSERT INTO colors (code, name) VALUES ('CC3', 'blue'); INSERT INTO colors (code, name) VALUES ('CC4', 'pink'); INSERT INTO product_colors (product_id, color_code) VALUES (1, 'CC1'); INSERT INTO product_colors (product_id, color_code) VALUES (1, 'CC2'); INSERT INTO product_colors (product_id, color_code) VALUES (2, 'CC4'); INSERT INTO product_colors (product_id, color_code) VALUES (3, 'CC2'); INSERT INTO product_colors (product_id, color_code) VALUES (3, 'CC3'); Rose-DB-Object-0.810/t/sandbox/convention/convention-test.pl000755 000765 000120 00000016215 11113677033 023775 0ustar00johnadmin000000 000000 #!/usr/bin/perl use strict; use lib '../../../lib'; use lib 'lib'; use My::Product; package My::Product; sub average_price { my($self) = shift; my %args; if(my $ref = ref $_[0]) { if($ref eq 'HASH') { %args = (query => [ %{shift(@_)} ], @_); } elsif(ref $_[0] eq 'ARRAY') { %args = (query => shift, @_); } } else { %args = @_ } my $meta = $self->meta; my $relationship = $self->meta->relationship('prices'); my $ft_columns = $relationship->key_columns; my $query_args = $relationship->query_args || []; my $mgr_args = $relationship->manager_args || {}; my $average; # Get query key my %key; while(my($local_column, $foreign_column) = each(%$ft_columns)) { my $local_method = $meta->column_accessor_method_name($local_column); $key{$foreign_column} = $self->$local_method(); # Comment this out to allow null keys unless(defined $key{$foreign_column}) { keys(%$ft_columns); # reset iterator $self->error("Could not get average via average_price() - the " . "$local_method attribute is undefined"); return; } } # Merge query args my @query = (%key, @$query_args, @{delete $args{'query'} || []}); # Merge the rest of the arguments foreach my $param (keys %args) { if(exists $mgr_args->{$param}) { my $ref = ref $args{$param}; if($ref eq 'ARRAY') { unshift(@{$args{$param}}, ref $mgr_args->{$param} ? @{$mgr_args->{$param}} : $mgr_args->{$param}); } elsif($ref eq 'HASH') { while(my($k, $v) = each(%{$mgr_args->{$param}})) { $args{$param}{$k} = $v unless(exists $args{$param}{$k}); } } } } while(my($k, $v) = each(%$mgr_args)) { $args{$k} = $v unless(exists $args{$k}); } $args{'object_class'} = $relationship->class; my $debug = $Rose::DB::Object::Manager::Debug || $args{'debug'}; # Make query for average eval { my($sql, $bind) = Rose::DB::Object::Manager->get_objects_sql( select => [ \q(AVG(price)) ], query => \@query, db => $self->db, %args); $debug && warn "$sql (", join(', ', @$bind), ")\n"; my $sth = $self->db->dbh->prepare($sql); $sth->execute(@$bind); $average = $sth->fetchrow_array; }; if($@) { $self->error("Could not average $args{'object_class'} objects - " . Rose::DB::Object::Manager->error); $meta->handle_error($self); return wantarray ? () : $average; } return $average; } package main; # use My::Price; # use My::Color; # use My::Vendor; # $p = My::Product->new(id => 1, name => 'A'); # $p->prices(My::Price->new(product_id => 1, region => 'IS', price => 1.23), # My::Price->new(product_id => 1, region => 'DE', price => 4.56)); # # $p->colors(My::Color->new(code => 'CC1', name => 'red'), # My::Color->new(code => 'CC2', name => 'green')); # # $p->vendor(My::Vendor->new(id => 1, name => 'V1')); # $p->save; my $p = My::Product->new(id => 1)->load; print "AVG(price) = ", $p->average_price, "\n"; print $p->vendor->name, "\n"; print join(', ', map { $_->region . ': ' . $_->price } $p->prices), "\n"; print join(', ', map { $_->name } $p->colors), "\n"; # Rose::DB::Object::Manager->get_objects( # object_class => 'My::Product', # debug => 1, # query => # [ # name => { like => 'Kite%' }, # id => { gt => 15 }, # ], # require_objects => [ 'vendor' ], # with_objects => [ 'colors', 'prices' ], # multi_many_ok => 1, # sort_by => 'name'); # # # Rose::DB::Object::Manager->get_objects( # object_class => 'My::Product', # debug => 1, # query => # [ # name => { like => 'Kite%' }, # id => { gt => 15 }, # ], # require_objects => [ 'vendor' ], # with_objects => [ 'colors' ], # sort_by => 'name'); # # # Rose::DB::Object::Manager->get_objects( # object_class => 'My::Product', # debug => 1, # query => # [ # name => { like => 'Kite%' }, # id => { gt => 15 }, # ], # with_objects => [ 'colors' ], # sort_by => 'name'); # # # Rose::DB::Object::Manager->get_objects( # object_class => 'My::Product', # debug => 1, # query => # [ # name => { like => 'Kite%' }, # id => { gt => 15 }, # ], # require_objects => [ 'vendor' ], # with_objects => [ 'prices' ], # sort_by => 'name'); # # # Rose::DB::Object::Manager->get_objects( # object_class => 'My::Product', # debug => 1, # query => # [ # name => { like => 'Kite%' }, # id => { gt => 15 }, # ], # with_objects => [ 'prices' ], # sort_by => 'name'); # # # Rose::DB::Object::Manager->get_objects( # object_class => 'My::Product', # debug => 1, # query => # [ # 'vendor.region.name' => 'UK', # 'name' => { like => 'Kite%' }, # 'id' => { gt => 15 }, # ], # require_objects => [ 'vendor.region' ], # with_objects => [ 'colors', 'prices' ], # multi_many_ok => 1, # sort_by => 'name'); __END__ DROP TABLE product_colors CASCADE; DROP TABLE prices CASCADE; DROP TABLE products CASCADE; DROP TABLE colors CASCADE; DROP TABLE vendors CASCADE; DROP TABLE regions CASCADE; CREATE TABLE regions ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) ); CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255), region_id INT REFERENCES regions (id) ); CREATE TABLE colors ( code CHAR(3) NOT NULL PRIMARY KEY, name VARCHAR(255) ); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255), vendor_id INT NOT NULL REFERENCES vendors (id) ); CREATE TABLE prices ( price_id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL ); CREATE TABLE product_colors ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), color_code CHAR(3) NOT NULL REFERENCES colors (code) ); INSERT INTO vendors (id, name) VALUES (1, 'V1'); INSERT INTO vendors (id, name) VALUES (2, 'V2'); INSERT INTO products (id, name, vendor_id) VALUES (1, 'A', 1); INSERT INTO products (id, name, vendor_id) VALUES (2, 'B', 2); INSERT INTO products (id, name, vendor_id) VALUES (3, 'C', 1); INSERT INTO prices (product_id, region, price) VALUES (1, 'US', 1.23); INSERT INTO prices (product_id, region, price) VALUES (1, 'DE', 4.56); INSERT INTO prices (product_id, region, price) VALUES (2, 'US', 5.55); INSERT INTO prices (product_id, region, price) VALUES (3, 'US', 5.78); INSERT INTO prices (product_id, region, price) VALUES (3, 'US', 9.99); INSERT INTO colors (code, name) VALUES ('CC1', 'red'); INSERT INTO colors (code, name) VALUES ('CC2', 'green'); INSERT INTO colors (code, name) VALUES ('CC3', 'blue'); INSERT INTO colors (code, name) VALUES ('CC4', 'pink'); INSERT INTO product_colors (product_id, color_code) VALUES (1, 'CC1'); INSERT INTO product_colors (product_id, color_code) VALUES (1, 'CC2'); INSERT INTO product_colors (product_id, color_code) VALUES (2, 'CC4'); INSERT INTO product_colors (product_id, color_code) VALUES (3, 'CC2'); INSERT INTO product_colors (product_id, color_code) VALUES (3, 'CC3'); Rose-DB-Object-0.810/t/sandbox/convention/lib/000750 000765 000120 00000000000 12266514754 021044 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/sandbox/convention/lib/My/000750 000765 000120 00000000000 12266514755 021432 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/sandbox/convention/lib/My/Auto/000750 000765 000120 00000000000 12266514755 022342 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/sandbox/convention/lib/My/Color.pm000644 000765 000120 00000000263 11113677033 023041 0ustar00johnadmin000000 000000 package My::Color; use strict; use base 'My::Object'; __PACKAGE__->meta->columns(qw(code name)); __PACKAGE__->meta->primary_key_columns('code'); __PACKAGE__->meta->initialize; 1; Rose-DB-Object-0.810/t/sandbox/convention/lib/My/DB.pm000644 000765 000120 00000000431 11113677033 022245 0ustar00johnadmin000000 000000 # Rose::DB subclass to handle the db connection package My::DB; use strict; use base 'Rose::DB'; __PACKAGE__->use_private_registry; My::DB->register_db ( type => 'default', domain => 'default', driver => 'Pg', database => 'test', username => 'postgres', ); 1; Rose-DB-Object-0.810/t/sandbox/convention/lib/My/Object.pm000644 000765 000120 00000000225 11113677033 023167 0ustar00johnadmin000000 000000 # Common Rose::DB::Object-derived base class package My::Object; use strict; use My::DB; use base 'Rose::DB::Object'; sub init_db { My::DB->new } 1; Rose-DB-Object-0.810/t/sandbox/convention/lib/My/Price.pm000644 000765 000120 00000000310 11113677033 023016 0ustar00johnadmin000000 000000 package My::Price; use strict; use base 'My::Object'; __PACKAGE__->meta->columns(qw(price_id product_id region price)); __PACKAGE__->meta->foreign_keys(qw(product)); __PACKAGE__->meta->initialize; 1; Rose-DB-Object-0.810/t/sandbox/convention/lib/My/Product.pm000644 000765 000120 00000000457 11113677033 023410 0ustar00johnadmin000000 000000 package My::Product; use strict; use base 'My::Object'; __PACKAGE__->meta->columns(qw(id name vendor_id)); __PACKAGE__->meta->foreign_keys(qw(vendor)); __PACKAGE__->meta->relationships ( prices => { type => 'one to many' }, colors => { type => 'many to many' }, ); __PACKAGE__->meta->initialize; 1; Rose-DB-Object-0.810/t/sandbox/convention/lib/My/ProductColors.pm000644 000765 000120 00000000316 11113677033 024564 0ustar00johnadmin000000 000000 package My::ProductColors; use strict; use base 'My::Object'; __PACKAGE__->meta->columns(qw(id product_id color_code)); __PACKAGE__->meta->foreign_keys(qw(product color)); __PACKAGE__->meta->initialize; 1; Rose-DB-Object-0.810/t/sandbox/convention/lib/My/Region.pm000644 000765 000120 00000000202 11113677033 023177 0ustar00johnadmin000000 000000 package My::Region; use strict; use base 'My::Object'; __PACKAGE__->meta->columns(qw(id name)); __PACKAGE__->meta->initialize; 1; Rose-DB-Object-0.810/t/sandbox/convention/lib/My/Vendor.pm000644 000765 000120 00000000271 11113677033 023217 0ustar00johnadmin000000 000000 package My::Vendor; use strict; use base 'My::Object'; __PACKAGE__->meta->columns(qw(id name region_id)); __PACKAGE__->meta->foreign_keys(qw(region)); __PACKAGE__->meta->initialize; 1; Rose-DB-Object-0.810/t/sandbox/convention/lib/My/Auto/Color.pm000644 000765 000120 00000000143 11113677033 023746 0ustar00johnadmin000000 000000 package My::Auto::Color; use strict; use base 'My::Object'; __PACKAGE__->meta->auto_initialize; 1; Rose-DB-Object-0.810/t/sandbox/convention/lib/My/Auto/Price.pm000644 000765 000120 00000000143 11113677033 023732 0ustar00johnadmin000000 000000 package My::Auto::Price; use strict; use base 'My::Object'; __PACKAGE__->meta->auto_initialize; 1; Rose-DB-Object-0.810/t/sandbox/convention/lib/My/Auto/Product.pm000644 000765 000120 00000000145 11113677033 024312 0ustar00johnadmin000000 000000 package My::Auto::Product; use strict; use base 'My::Object'; __PACKAGE__->meta->auto_initialize; 1; Rose-DB-Object-0.810/t/sandbox/convention/lib/My/Auto/ProductColors.pm000644 000765 000120 00000000154 11113677033 025474 0ustar00johnadmin000000 000000 package My::Auto::ProductColors; use strict; use base 'My::Object'; __PACKAGE__->meta->auto_initialize; 1; Rose-DB-Object-0.810/t/sandbox/convention/lib/My/Auto/Vendor.pm000644 000765 000120 00000000144 11113677033 024126 0ustar00johnadmin000000 000000 package My::Auto::Vendor; use strict; use base 'My::Object'; __PACKAGE__->meta->auto_initialize; 1; Rose-DB-Object-0.810/t/sandbox/code-gen/generated-perl-test.pl000755 000765 000120 00000005761 11113677033 024014 0ustar00johnadmin000000 000000 #!/usr/bin/perl use lib '../../../../Rose-DB/lib'; use lib '../../../lib'; use lib 'lib'; use My::Product; # use My::Price; # use My::Color; # use My::Vendor; # $p = My::Product->new(id => 1, name => 'A'); # $p->prices(My::Price->new(product_id => 1, region => 'IS', price => 1.23), # My::Price->new(product_id => 1, region => 'DE', price => 4.56)); # # $p->colors(My::Color->new(code => 'CC1', name => 'red'), # My::Color->new(code => 'CC2', name => 'green')); # # $p->vendor(My::Vendor->new(id => 1, name => 'V1')); # $p->save; $p = My::Product->new(id => 1)->load; print $p->vendor->name, "\n"; print join(', ', map { $_->region . ': ' . $_->price } $p->prices), "\n"; print join(', ', map { $_->name } $p->colors), "\n"; $c = My::Color->new(name => 'red')->load; print $c->name, ': ', $c->code, "\n"; #My::Product->meta->auto_load_related_classes(0); #print My::Product->meta->perl_class_definition(braces => 'bsd', indent => 2); __END__ DROP TABLE product_colors CASCADE; DROP TABLE prices CASCADE; DROP TABLE products CASCADE; DROP TABLE colors CASCADE; DROP TABLE vendors CASCADE; CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) ); CREATE TABLE colors ( code CHAR(3) NOT NULL PRIMARY KEY, name VARCHAR(255) ); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255), vendor_id INT NOT NULL REFERENCES vendors (id) ); CREATE TABLE prices ( price_id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL ); CREATE TABLE product_colors ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), color_code CHAR(3) NOT NULL REFERENCES colors (code) ); INSERT INTO vendors (id, name) VALUES (1, 'V1'); INSERT INTO vendors (id, name) VALUES (2, 'V2'); INSERT INTO products (id, name, vendor_id) VALUES (1, 'A', 1); INSERT INTO products (id, name, vendor_id) VALUES (2, 'B', 2); INSERT INTO products (id, name, vendor_id) VALUES (3, 'C', 1); INSERT INTO prices (product_id, region, price) VALUES (1, 'US', 1.23); INSERT INTO prices (product_id, region, price) VALUES (1, 'DE', 4.56); INSERT INTO prices (product_id, region, price) VALUES (2, 'US', 5.55); INSERT INTO prices (product_id, region, price) VALUES (3, 'US', 5.78); INSERT INTO prices (product_id, region, price) VALUES (3, 'US', 9.99); INSERT INTO colors (code, name) VALUES ('CC1', 'red'); INSERT INTO colors (code, name) VALUES ('CC2', 'green'); INSERT INTO colors (code, name) VALUES ('CC3', 'blue'); INSERT INTO colors (code, name) VALUES ('CC4', 'pink'); INSERT INTO product_colors (product_id, color_code) VALUES (1, 'CC1'); INSERT INTO product_colors (product_id, color_code) VALUES (1, 'CC2'); INSERT INTO product_colors (product_id, color_code) VALUES (2, 'CC4'); INSERT INTO product_colors (product_id, color_code) VALUES (3, 'CC2'); INSERT INTO product_colors (product_id, color_code) VALUES (3, 'CC3'); Rose-DB-Object-0.810/t/sandbox/code-gen/lib/000750 000765 000120 00000000000 12266514755 020344 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/sandbox/code-gen/make-modules.pl000755 000765 000120 00000005267 11113677033 022525 0ustar00johnadmin000000 000000 #!/usr/bin/perl use lib '../../../../Rose-DB/lib'; use lib '../../../lib'; require '../../test-lib.pl'; use Rose::DB::Object::Loader; #Rose::DB->default_type('pg'); #my $db = Rose::DB->new('pg'); my $loader = Rose::DB::Object::Loader->new( #db => $db, #db_class => 'Rose::DB', db_dsn => 'dbi:Pg:dbname=test;host=localhost', db_username => 'postgres', class_prefix => 'My::'); $loader->make_modules(module_dir => 'lib', braces => 'bsd', indent => 2); # auto_load_related_classes => 0 __END__ DROP TABLE product_colors CASCADE; DROP TABLE prices CASCADE; DROP TABLE products CASCADE; DROP TABLE colors CASCADE; DROP TABLE vendors CASCADE; CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) ); CREATE TABLE colors ( code CHAR(3) NOT NULL PRIMARY KEY, name VARCHAR(255), UNIQUE(name) ); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255), vendor_id INT NOT NULL REFERENCES vendors (id), UNIQUE(name, vendor_id), UNIQUE(name) ); CREATE TABLE prices ( price_id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL ); CREATE TABLE product_colors ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), color_code CHAR(3) NOT NULL REFERENCES colors (code) ); INSERT INTO vendors (id, name) VALUES (1, 'V1'); INSERT INTO vendors (id, name) VALUES (2, 'V2'); INSERT INTO products (id, name, vendor_id) VALUES (1, 'A', 1); INSERT INTO products (id, name, vendor_id) VALUES (2, 'B', 2); INSERT INTO products (id, name, vendor_id) VALUES (3, 'C', 1); INSERT INTO prices (product_id, region, price) VALUES (1, 'US', 1.23); INSERT INTO prices (product_id, region, price) VALUES (1, 'DE', 4.56); INSERT INTO prices (product_id, region, price) VALUES (2, 'US', 5.55); INSERT INTO prices (product_id, region, price) VALUES (3, 'US', 5.78); INSERT INTO prices (product_id, region, price) VALUES (3, 'US', 9.99); INSERT INTO colors (code, name) VALUES ('CC1', 'red'); INSERT INTO colors (code, name) VALUES ('CC2', 'green'); INSERT INTO colors (code, name) VALUES ('CC3', 'blue'); INSERT INTO colors (code, name) VALUES ('CC4', 'pink'); INSERT INTO product_colors (product_id, color_code) VALUES (1, 'CC1'); INSERT INTO product_colors (product_id, color_code) VALUES (1, 'CC2'); INSERT INTO product_colors (product_id, color_code) VALUES (2, 'CC4'); INSERT INTO product_colors (product_id, color_code) VALUES (3, 'CC2'); INSERT INTO product_colors (product_id, color_code) VALUES (3, 'CC3'); Rose-DB-Object-0.810/t/sandbox/code-gen/lib/.placeholder000644 000765 000120 00000000000 11113677033 022607 0ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/lib/My/000750 000765 000120 00000000000 12266514754 015611 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/lib/My/DB/000750 000765 000120 00000000000 12266514755 016077 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/lib/My/DB/Gene/000750 000765 000120 00000000000 12266514755 016755 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/lib/My/DB/Gene2Unigene.pm000644 000765 000120 00000000615 11113677033 020704 0ustar00johnadmin000000 000000 package My::DB::Gene2Unigene; use My::DB::Gene::Main; use My::DB::Unigene::Main; use base qw(My::DB::Object); __PACKAGE__->meta->table('Rose_db_object_g_ug'); __PACKAGE__->meta->auto_initialize(with_relationships => 0); package My::DB::Gene2Unigene::Manager; use base qw(Rose::DB::Object::Manager); sub object_class { 'My::DB::Gene2Unigene' } __PACKAGE__->make_manager_methods('gug'); 1; Rose-DB-Object-0.810/t/lib/My/DB/Object.pm000644 000765 000120 00000000074 11113677033 017636 0ustar00johnadmin000000 000000 package My::DB::Object; use base qw(Rose::DB::Object); 1; Rose-DB-Object-0.810/t/lib/My/DB/Opa/000750 000765 000120 00000000000 12266514755 016616 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/lib/My/DB/Opa.pm000644 000765 000120 00000000740 12011204451 017133 0ustar00johnadmin000000 000000 package My::DB::Opa; use strict; use base qw(Rose::DB); our $Connection_Count = 0; __PACKAGE__->use_private_registry; __PACKAGE__->registry->add_entry(Rose::DB->registry->entry(type => 'sqlite_admin', domain => 'test')->clone); __PACKAGE__->default_type('sqlite_admin'); sub init_dbh { $Connection_Count++; return shift->SUPER::init_dbh(@_); } sub connection_count { my ($self, $val) = @_; return defined $val ? $Connection_Count = $val : $Connection_Count; } 1; Rose-DB-Object-0.810/t/lib/My/DB/Unigene/000750 000765 000120 00000000000 12266514754 017470 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/lib/My/DB/Unigene/Main.pm000644 000765 000120 00000001002 11113677033 020676 0ustar00johnadmin000000 000000 package My::DB::Unigene::Main; use My::DB::Gene2Unigene; use base qw(My::DB::Object); __PACKAGE__->meta->table('Rose_db_object_ug_main'); __PACKAGE__->meta->relationships ( genes => { type => 'many to many', map_class => 'My::DB::Gene2Unigene' }, ); __PACKAGE__->meta->auto_initialize(relationship_types => []); package My::DB::Unigene::Main::Manager; use base qw(Rose::DB::Object::Manager); sub object_class { 'My::DB::Unigene::Main' } __PACKAGE__->make_manager_methods('ugmain'); 1; Rose-DB-Object-0.810/t/lib/My/DB/Opa/Object.pm000644 000765 000120 00000000212 12011204511 020330 0ustar00johnadmin000000 000000 package My::DB::Opa::Object; use strict; use base 'Rose::DB::Object'; use My::DB::Opa; sub init_db { My::DB::Opa->new_or_cached } 1; Rose-DB-Object-0.810/t/lib/My/DB/Gene/Main.pm000644 000765 000120 00000000773 11113677033 020200 0ustar00johnadmin000000 000000 package My::DB::Gene::Main; use My::DB::Gene2Unigene; use base qw(My::DB::Object); __PACKAGE__->meta->table('Rose_db_object_g_main'); __PACKAGE__->meta->relationships ( unigenes => { type => 'many to many', map_class => 'My::DB::Gene2Unigene' }, ); __PACKAGE__->meta->auto_initialize(relationship_types => []); package My::DB::Gene::Main::Manager; use base qw(Rose::DB::Object::Manager); sub object_class { 'My::DB::Gene::Main' } __PACKAGE__->make_manager_methods('gmain'); 1; Rose-DB-Object-0.810/t/benchmarks/bench.pl000755 000765 000120 00000415375 12117136207 020222 0ustar00johnadmin000000 000000 #!/usr/bin/perl use strict; use FindBin qw($Bin); require "$Bin/../test-lib.pl"; use lib "$Bin/../../lib"; use lib "$Bin/lib"; use Rose::DB; use Rose::DB::Object; use Rose::DB::Object::Util qw(:all); use Benchmark qw(timethese cmpthese); # :hireswallclock our(%Have_PM, %Use_PM, %Have_DB, @Use_DBs, %Inited_DB, $DB, $DBH, $Term, $Pager); our @Cmp_To = (qw(DBI Class::DBI Class::DBI::Sweet DBIx::Class)); our %Cmp_Abbreviation = ( 'DBI' => 'DBI', 'Class::DBI' => 'CDBI', 'Class::DBI::Sweet' => 'CDBS', 'DBIx::Class' => 'DBIC', ); our %DB_Name = ( pg => 'PostgreSQL', mysql => 'MySQL', informix => 'Informix', sqlite => 'SQLite', ); our %DB_Tag; @DB_Tag{values %DB_Name} = keys %DB_Name; our $Default_CPU_Time = 5; our $Default_Iterations = 1000; our $Min_DBI_Iterations = 3000; use Getopt::Long; our %Opt; Getopt::Long::config('auto_abbrev'); GetOptions(\%Opt, 'help', 'skip-intro', 'benchmarks-match|filter|bench-match=s', 'debug', 'cpu-time=i', 'compare-to|cmp-to=s', 'time', 'compare', 'no-versions', 'time-and-compare', 'simple', 'complex', 'iterations=i', 'innodb|mysql-uses-innodb', 'simple-and-complex', 'hi-res-time', 'no-rdbo|nordbo', 'no-readline', 'database|db=s') or Usage(); Usage() if($Opt{'help'}); our $Debug = $Opt{'debug'} || 0; our $CPU_Time = $Opt{'cpu-time'} || $Default_CPU_Time; $CPU_Time = -$CPU_Time if($CPU_Time > 0); our $No_RDBO = $Opt{'no-rdbo'} || 0; unless($Opt{'time'} || $Opt{'time-and-compare'}) { $Opt{'compare'} = 1; delete @Opt{qw(time time-and-compare)}; } unless($Opt{'simple'} || $Opt{'complex'}) { $Opt{'simple-and-complex'} = 1; delete @Opt{qw(simple complex)}; } our $Bench_Match = $Opt{'benchmarks-match'} ? qr($Opt{'benchmarks-match'}|insert) : 0; our $Iterations = $Opt{'iterations'} || $Default_Iterations; our $Limit_Dialect; our %Limit_Dialect = ( pg => 'LimitOffset', mysql => 'LimitXY', sqlite => 'LimitOffset', informix => 'First', ); # DBIx::Class schema objects our($Schema, $DBIC_Simple_Code_RS, $DBIC_Simple_CodeName_RS, $DBIC_Simple_Category_RS, $DBIC_Simple_Product_RS, $DBIC_Complex_Code_RS, $DBIC_Complex_CodeName_RS, $DBIC_Complex_Category_RS, $DBIC_Complex_Product_RS); use constant LIMIT => 100; use constant OFFSET => 50; use constant MAX_LIMIT => 1000; Benchmark->import(':hireswallclock') if($Opt{'hi-res-time'}); MAIN: { Init(); foreach my $db_type (@Use_DBs) { $Limit_Dialect = $Limit_Dialect{$db_type}; print<<"EOF"; ## ## Benchmark against @{[ join(', ', @Cmp_To) ]} using $DB_Name{$db_type} ## EOF unless($Opt{'no-versions'}) { my $len = 0; foreach my $class (($No_RDBO ? () : 'Rose::DB::Object'), @Cmp_To) { $len = length($class) if(length($class) > $len); } printf("%-*s Version\n", $len, 'Module'); printf("%-*s -------\n", $len, '-' x $len); foreach my $class (sort((($No_RDBO ? () : 'Rose::DB::Object'), @Cmp_To))) { no strict 'refs'; printf("%-*s " . ${"${class}::VERSION"} . "\n", $len, $class); } print "\n"; } Rose::DB->default_type($db_type); unless($No_RDBO) { require MyTest::RDBO::Simple::Code; require MyTest::RDBO::Simple::CodeName; require MyTest::RDBO::Simple::Category; require MyTest::RDBO::Simple::Product; if($Opt{'simple'} || $Opt{'simple-and-complex'}) { require MyTest::RDBO::Simple::Product::Manager; require MyTest::RDBO::Simple::Category::Manager; } if($Opt{'complex'} || $Opt{'simple-and-complex'}) { require MyTest::RDBO::Complex::Code; require MyTest::RDBO::Complex::CodeName; require MyTest::RDBO::Complex::Category; require MyTest::RDBO::Complex::Product; require MyTest::RDBO::Complex::Product::Manager; require MyTest::RDBO::Complex::Category::Manager; } } $DB = Rose::DB->new; $DBH = Rose::DB->new->retain_dbh; if($Use_PM{'Class::DBI'}) { require MyTest::CDBI::Simple::Code; require MyTest::CDBI::Simple::CodeName; require MyTest::CDBI::Simple::Category; require MyTest::CDBI::Simple::Product; if($Opt{'complex'} || $Opt{'simple-and-complex'}) { require MyTest::CDBI::Complex::Code; require MyTest::CDBI::Complex::CodeName; require MyTest::CDBI::Complex::Category; require MyTest::CDBI::Complex::Product; } MyTest::CDBI::Base->refresh; } if($Use_PM{'Class::DBI::Sweet'}) { require MyTest::CDBI::Sweet::Simple::Code; require MyTest::CDBI::Sweet::Simple::CodeName; require MyTest::CDBI::Sweet::Simple::Category; require MyTest::CDBI::Sweet::Simple::Product; if($Opt{'complex'} || $Opt{'simple-and-complex'}) { require MyTest::CDBI::Sweet::Complex::Code; require MyTest::CDBI::Sweet::Complex::CodeName; require MyTest::CDBI::Sweet::Complex::Category; require MyTest::CDBI::Sweet::Complex::Product; } MyTest::CDBI::Sweet::Base->refresh; } if($Use_PM{'DBIx::Class'}) { if($DBIx::Class::VERSION < 0.05999_03) { die "Sorry, this benchmark suite requires DBIx::Class version 0.05999_03 or later.\n"; } require MyTest::DBIC::Schema; require MyTest::DBIC::Schema::Simple::Code; require MyTest::DBIC::Schema::Simple::CodeName; require MyTest::DBIC::Schema::Simple::Category; require MyTest::DBIC::Schema::Simple::Product; $MyTest::DBIC::Schema::DB = Rose::DB->new; $Schema = MyTest::DBIC::Schema->connect(sub { $MyTest::DBIC::Schema::DB->retain_dbh }); $DBIC_Simple_Code_RS = $Schema->resultset('MyTest::DBIC::Schema::Simple::Code'); $DBIC_Simple_CodeName_RS = $Schema->resultset('MyTest::DBIC::Schema::Simple::CodeName'); $DBIC_Simple_Category_RS = $Schema->resultset('MyTest::DBIC::Schema::Simple::Category'); $DBIC_Simple_Product_RS = $Schema->resultset('MyTest::DBIC::Schema::Simple::Product'); if($Opt{'complex'} || $Opt{'simple-and-complex'}) { require MyTest::DBIC::Schema::Complex::Code; require MyTest::DBIC::Schema::Complex::CodeName; require MyTest::DBIC::Schema::Complex::Category; require MyTest::DBIC::Schema::Complex::Product; $DBIC_Complex_Code_RS = $Schema->resultset('MyTest::DBIC::Schema::Complex::Code'); $DBIC_Complex_CodeName_RS = $Schema->resultset('MyTest::DBIC::Schema::Complex::CodeName'); $DBIC_Complex_Category_RS = $Schema->resultset('MyTest::DBIC::Schema::Complex::Category'); $DBIC_Complex_Product_RS = $Schema->resultset('MyTest::DBIC::Schema::Complex::Product'); } } Run_Tests(); print "\n"; } } sub Get_Pager { return $Pager if($Pager); foreach my $exe ($ENV{'PAGER'}, '/usr/bin/less', '/bin/less') { if(-x $exe) { $Pager = $exe; last; } } return $Pager; } sub Usage { my $pager = Get_Pager(); local $SIG{'PIPE'} = 'IGNORE'; if($pager) { my $fh; open($fh, "| $pager -E") && select($fh); } my $prog = $0; $prog =~ s{.*/}{}; print<<"EOF"; Usage: $prog --help | [--skip-intro] [--cpu-time ] [--compare-to ] [--database ] [--time | --compare | --time-and-compare] [--simple | --complex | --simple-and-complex] [--iterations ] [--hi-res-time] [--innodb] [--no-rdbo] [--no-readline] [--benchmarks-match ] --benchmarks-match Only run benchmarks whose names match . Note: the "insert" benchmarks will always be run. (Otherwise, there'd be no data to benchmark against.) --compare-to | --cmp Benchmark Rose::DB::Object against , which is a comma- separated list of one or more for the following: @{[join(', ', @Cmp_To)]} The special value "all" can be used to specify all available modules. (To exclude Rose::DB::Object, see the --no-rdbo option below.) --database Use to run benchmarks, where is a one of the following database types: @{[join(', ', sort keys %DB_Name)]} --cpu-time The minimum amount of CPU time in seconds to spend on benchmarks that do not require a predictible number of iterations. Defaults to $Default_CPU_Time. --hi-res-time Use high-resolution wall-clock time measurement, if available. --innodb When benchmarking against MySQL, use the InnoDB storage engine. --iterations The number of iterations to use for benchmarks that must be run a predictible number of times. The default is $Default_Iterations. --no-rdbo Do not automatically include Rose::DB::Object in the list of modules to benchmark. Note: Rose::DB must still be installed, since it provides the DBI database handle used during the tests. --no-readline Do not use the Term::ReadLine library. --time --compare --time-and-compare Select only one of these flags to specify whether to time, compare, or both time and compare each benchmark. (perldoc Benchmark and see the timethese() and cmpthese() functions.) "Compare" is the default. --simple --complex --simple-and-complex Select only one of these flags to specify whether to test with simple objects (no column inflate/deflate), complex objects, or both. "Simple and complex" is the default. --help Show this help screen. --skip-intro Skip the introductory message. EOF exit(1); } sub NVL { defined $ENV{$_[0]} ? $ENV{$_[0]} : $_[1] } sub Init { Init_Term(); Init_PM(); unless(%Have_PM) { print "Could not load any comparison modules: ", join(', ', sort keys %Have_PM), "\nExiting...\n"; exit(1); } unless($Opt{'skip-intro'}) { my $pager = Get_Pager(); local $SIG{'PIPE'} = 'IGNORE'; if($pager) { my $fh; open($fh, "| $pager -E") && select($fh); } print<<"EOF"; ## ## WARNING: These benchmarks need to connect to a database in order to run. ## The benchmarks need full privileges on this database: the ability to ## create and drop tables, insert, update, and delete rows, create schemas, ## sequences, functions, triggers, the works. ## ## By default, the benchmarks will try to connect to the database named ## "test" running on "localhost" using the default superuser username for ## each database type and an empty password. ## ## If you have setup your database in a secure manner, these connection ## attempts will fail, and the benchmarks will be skipped. If you want to ## override these values, set the following environment variables before ## running tests. (The current values are shown in parentheses.) ## ## PostgreSQL: ## ## RDBO_PG_DSN (@{[ NVL('RDBO_PG_DSN', 'dbi:Pg:dbname=test;host=localhost') ]}) ## RDBO_PG_USER (@{[ NVL('RDBO_PG_USER', 'postgres') ]}) ## RDBO_PG_PASS (@{[ NVL('RDBO_PG_PASS', '') ]}) ## ## MySQL: ## ## RDBO_MYSQL_DSN (@{[ NVL('RDBO_MYSQL_DSN', 'dbi:mysql:database=test;host=localhost') ]}) ## RDBO_MYSQL_USER (@{[ NVL('RDBO_MYSQL_USER', 'root') ]}) ## RDBO_MYSQL_PASS (@{[ NVL('RDBO_MYSQL_PASS', '') ]}) ## ## Informix: ## ## RDBO_INFORMIX_DSN (@{[ NVL('RDBO_INFORMIX_DSN', 'dbi:Informix:test@test') ]}) ## RDBO_INFORMIX_USER (@{[ NVL('RDBO_INFORMIX_USER', '') ]}) ## RDBO_INFORMIX_PASS (@{[ NVL('RDBO_INFORMIX_PASS', '') ]}) ## ## SQLite: ## ## To disable the SQLite tests, set this varible to a true value: ## ## RDBO_NO_SQLITE (@{[ NVL('RDBO_NO_SQLITE', '') ]}) ## ## Press return to continue (or wait 60 seconds) EOF select(STDOUT); my %old; $old{'ALRM'} = $SIG{'ALRM'} || 'DEFAULT'; eval { # Localize so I only have to restore in my catch block local $SIG{'ALRM'} = sub { die 'alarm' }; alarm(60); my $res = ; alarm(0); }; if($@ =~ /alarm/) { $SIG{'ALRM'} = $old{'ALRM'}; } } Check_DB(); unless(%Have_DB) { print "Could not connect to any databases. Exiting...\n"; exit(1); } my $question =<<"EOF"; The following comparison modules were found: @{[join("\n", map { " $_" } sort keys %Have_PM)]} Which ones would you like to compare with? EOF WHICH_PM: { my $response = $Opt{'compare-to'} ? $Opt{'compare-to'} : (keys %Have_PM == 1) ? (keys %Have_PM)[0] : Ask(question => $question, prompt => 'Compare with', default => join(', ', sort grep { $_ ne 'DBI' } keys %Have_PM), no_newline => 1); $response =~ s/,/ /g; @Cmp_To = split(/\s+/, $response); foreach my $pm (@Cmp_To) { unless($Cmp_Abbreviation{$pm}) { print "\n*** ERROR: Unknown module: '$pm'\n\n"; sleep(1); exit(1) if($Opt{'compare-to'}); redo WHICH_PM; } unless($Have_PM{$pm}) { print "\n*** ERROR: Do not have module '$pm'\n\n"; sleep(1); exit(1) if($Opt{'compare-to'}); redo WHICH_PM; } } } %Use_PM = map { $_ => 1 } @Cmp_To; $question =<<"EOF"; The following databases are configured: @{[join("\n", map { " $DB_Name{$_}" } sort keys %Have_DB)]} Which one would you like to use? EOF WHICH_DB: { my $response = $Opt{'database'} ? $Opt{'database'} : Ask(question => $question, prompt => 'Use database', default => (map { $DB_Name{$_} } sort keys %Have_DB)[0]); $response =~ s/,/ /g; @Use_DBs = split(/\s+/, $response); foreach my $db (@Use_DBs) { unless($DB_Name{$db} || $DB_Tag{$db}) { print "\n*** ERROR: Unknown or unavailable database: '$db'\n\n"; sleep(1); exit(1) if($Opt{'database'}); redo WHICH_DB; } $db = $DB_Tag{$db} if($DB_Tag{$db}); } } if(@Use_DBs > 1) { warn<<"EOF"; *** WARNING: benchmarks may fail when trying to use multiple databases. EOF } Init_DB(); # Not supporting DBI test on Informix right now due to the stupid way it # does limits and offsets...or rather, *doesn't* handle offsets in # informix versions prior to 10. if($Inited_DB{'informix'} && $Use_PM{'DBI'}) { die<<"EOF"; *** ERROR: DBI tests not supported on Informix *** Cannot benchmark against DBI using the Informix database due to Informix's limited support for "limit with offset" in SELECT statements. Please choose a different database. EOF } # Warn about speedy DBI causing too few iterations if(!$Opt{'iterations'} && $Use_PM{'DBI'} && $Iterations < $Min_DBI_Iterations) { warn<<"EOF"; *** WARNING *** When benchmarking against DBI, you may need to increase the number of iterations to at least $Min_DBI_Iterations in oder to avoid a warning about "too few iterations" from the Benchmark.pm module. (That number may be different, depending on how fast your system is.) Consider running the benchmark again with "--iterations $Min_DBI_Iterations" Press return to continue (or wait 60 seconds) EOF my %old; $old{'ALRM'} = $SIG{'ALRM'} || 'DEFAULT'; eval { # Localize so I only have to restore in my catch block local $SIG{'ALRM'} = sub { die 'alarm' }; alarm(60); my $res = ; alarm(0); }; if($@ =~ /alarm/) { $SIG{'ALRM'} = $old{'ALRM'}; } } } sub Init_PM { foreach my $class (@Cmp_To) { eval "use $class"; $Have_PM{$class} = 1 unless($@); } $Opt{'compare-to'} = join(',', sort keys %Have_PM) if($Opt{'compare-to'} eq 'all'); } sub Init_Term { return if($Opt{'no-readline'}); eval { require Term::ReadLine }; return if($@); $Term = Term::ReadLine->new('bench'); if($Term->ReadLine =~ /::Stub$/) # the stub doesn't do what we need { $Term = undef; return; } else { # Get rid of that underlining crap $Term->ornaments(0); ($Term->OUT) ? select($Term->OUT) : select(STDOUT); } } sub Ask { my(%args) = @_; my $response; ASK: { for($args{'question'}) { s/\A\n*/\n/ unless($args{'no_newline'}); s/\s*\Z/\n\n/; } print $args{'question'}; $response = Prompt(prompt => $args{'prompt'}, default => $args{'default'}); redo ASK unless(defined $response); } return $response; } sub Prompt { my(%args) = @_; %args = (prompt => $_[1]) if(@_ == 2); my($term, $response); if($Term) { $args{'prompt'} .= ': ' unless($args{'prompt'} =~ /\s$/); $response = $Term->readline($args{'prompt'}, $args{'default'}) } else { print "$args{'prompt'} ($args{'default'}): "; chomp($response = ); } unless($response =~ /\S/) { $response = $args{'default'} if(!$Term && length $args{'default'}); $Term->addhistory($response) if($Term); } return $response; } sub Refresh_DBs { $Debug && warn "Reconnect to database...\n"; $DB = Rose::DB->new; $DBH = Rose::DB->new->retain_dbh; if(UNIVERSAL::isa('MyTest::CDBI::Base', 'Class::DBI') && MyTest::CDBI::Base->can('db_Main')) { my $dbh = MyTest::CDBI::Base->db_Main; $dbh->{'CachedKids'} = {}; $dbh->disconnect; } if(UNIVERSAL::isa('MyTest::CDBI::Sweet::Base', 'Class::DBI::Sweet') && MyTest::CDBI::Sweet::Base->can('db_Main')) { my $dbh = MyTest::CDBI::Sweet::Base->db_Main; $dbh->{'CachedKids'} = {}; $dbh->disconnect; } if($Schema) { my $dbh = $Schema->storage->dbh; $dbh->{'CachedKids'} = {}; $dbh->disconnect; } } use constant MAX_CODE_NAMES_RANGE => 10; use constant MIN_CODE_NAMES => 1; sub Insert_Code_Names { if($Bench_Match && 'Simple: search with 1-to-1 and 1-to-n sub-objects' !~ $Bench_Match && 'Complex: search with 1-to-1 and 1-to-n sub-objects' !~ $Bench_Match) { return; } local $|= 1; print "\n# Inserting 1-to-n records"; my %cmp = map { $_ => 1 } @Cmp_To; my $sql = 'INSERT INTO rose_db_object_test_code_names (product_id, name) VALUES (?, ?)'; my $dbi_factor = $Opt{'simple-and-complex'} ? 2 : 1; my $simple = $Opt{'simple'} || $Opt{'simple-and-complex'}; my $complex = $Opt{'complex'} || $Opt{'simple-and-complex'}; foreach my $db_name (@Use_DBs) { my $db = Rose::DB->new($db_name); $db->autocommit(0); $db->begin_work; my $dbh = $db->dbh; my $sth = $dbh->prepare($sql); # RDBO unless($No_RDBO) { foreach my $i (1 .. $Iterations) { foreach my $n (1 .. (int rand(MAX_CODE_NAMES_RANGE) + MIN_CODE_NAMES)) { $sth->execute($i + 100_000, "CN 1x$n $i") if($simple); $sth->execute($i + 1_100_000, "CN 1.1x$n $i") if($complex); } } print '.'; } # CDBI if($cmp{'Class::DBI'}) { foreach my $i (1 .. $Iterations) { foreach my $n (1 .. (int rand(MAX_CODE_NAMES_RANGE) + MIN_CODE_NAMES)) { $sth->execute($i + 200_000, "CN 2x$n $i") if($simple); $sth->execute($i + 2_200_000, "CN 2.2x$n $i") if($complex); } } } print '.'; # CDBS if($cmp{'Class::DBI::Sweet'}) { foreach my $i (1 .. $Iterations) { foreach my $n (1 .. (int rand(MAX_CODE_NAMES_RANGE) + MIN_CODE_NAMES)) { $sth->execute($i + 400_000, "CN 4x$n $i") if($simple); $sth->execute($i + 4_400_000, "CN 4.4x$n $i") if($complex); } } } print '.'; # DBIC if($cmp{'DBIx::Class'}) { foreach my $i (1 .. $Iterations) { foreach my $n (1 .. (int rand(MAX_CODE_NAMES_RANGE) + MIN_CODE_NAMES)) { $sth->execute($i + 300_000, "CN 3x$n $i") if($simple); $sth->execute($i + 3_300_000, "CN 3.3x$n $i") if($complex); } } } print '.'; # DBI if($cmp{'DBI'}) { foreach my $i (1 .. ($Iterations * $dbi_factor)) { foreach my $n (1 .. (int rand(MAX_CODE_NAMES_RANGE) + MIN_CODE_NAMES)) { $sth->execute($i + 500_000, "CN 5x$n $i") if($simple); # No "complex" DBI tests #$sth->execute($i + 5_500_000, "CN 5.5x$n $i"); } } } $db->commit; print ".\n"; if($db->driver eq 'pg') { $dbh->do('analyze'); } elsif($db->driver eq 'sqlite') { Refresh_DBs(); } } } sub Make_Indexes { if($Bench_Match && 'Simple: search with 1-to-1 and 1-to-n sub-objects' !~ $Bench_Match && 'Complex: search with 1-to-1 and 1-to-n sub-objects' !~ $Bench_Match && 'Simple: search with 1-to-1 sub-objects' !~ $Bench_Match && 'Complex: search with 1-to-1 sub-objects' !~ $Bench_Match) { return; } print "\n# Making indexes...\n"; my %cmp = map { $_ => 1 } @Cmp_To; foreach my $db_name (@Use_DBs) { my $db = Rose::DB->new($db_name); my $dbh = $db->dbh; $dbh->do(<<"EOF"); CREATE INDEX rose_db_object_test_products_name_idx ON rose_db_object_test_products (name) EOF $dbh->do(<<"EOF"); CREATE INDEX rose_db_object_test_code_names_pid_idx ON rose_db_object_test_code_names (product_id) EOF } if($DB->driver eq 'sqlite') { Refresh_DBs(); } } sub Drop_Indexes { if($Bench_Match && 'Simple: search with 1-to-1 and 1-to-n sub-objects' !~ $Bench_Match && 'Complex: search with 1-to-1 and 1-to-n sub-objects' !~ $Bench_Match && 'Simple: search with 1-to-1 sub-objects' !~ $Bench_Match && 'Complex: search with 1-to-1 sub-objects' !~ $Bench_Match) { return; } print "\n# Dropping indexes...\n"; my %cmp = map { $_ => 1 } @Cmp_To; foreach my $db_name (@Use_DBs) { my $db = Rose::DB->new($db_name); my $dbh = $db->dbh; my $on = ($db_name eq 'mysql') ? 'ON rose_db_object_test_products' : ''; $dbh->do(<<"EOF"); DROP INDEX rose_db_object_test_products_name_idx $on EOF $on = ($db_name eq 'mysql') ? 'ON rose_db_object_test_code_names' : ''; $dbh->do(<<"EOF"); DROP INDEX rose_db_object_test_code_names_pid_idx $on EOF $dbh->do(<<"EOF"); DELETE FROM rose_db_object_test_code_names EOF } if($DB->driver eq 'sqlite') { Refresh_DBs(); } } ## ## Benchmark subroutines ## BEGIN { ## ## Simple ## # # Insert # INSERT_SIMPLE_CATEGORY_DBI: { my $i = 1; sub insert_simple_category_dbi { my $sth = $DBH->prepare('INSERT INTO rose_db_object_test_categories (id, name) VALUES (?, ?)'); $sth->execute($i + 500_000, "xCat $i"); $i++; } } INSERT_SIMPLE_CATEGORY_RDBO: { my $i = 1; sub insert_simple_category_rdbo { my $c = MyTest::RDBO::Simple::Category->new( db => $DB, id => $i + 100_000, name => "xCat $i"); $c->save; $i++; } } INSERT_SIMPLE_CATEGORY_CDBI: { my $i = 1; sub insert_simple_category_cdbi { MyTest::CDBI::Simple::Category->create({ id => $i + 200_000, name => "xCat $i" }); $i++; } } INSERT_SIMPLE_CATEGORY_CDBS: { my $i = 1; sub insert_simple_category_cdbs { MyTest::CDBI::Sweet::Simple::Category->create({ id => $i + 400_000, name => "xCat $i" }); $i++; } } INSERT_SIMPLE_CATEGORY_DBIC: { my $i = 1; sub insert_simple_category_dbic { #MyTest::DBIC::Schema::Simple::Category->create({ id => $i + 300_000, name => "xCat $i" }); $DBIC_Simple_Category_RS->create({ id => $i + 300_000, name => "xCat $i" }); $i++; } } INSERT_SIMPLE_PRODUCT_DBI: { my $i = 1; sub insert_simple_product_dbi { my $sth = $DBH->prepare(<<"EOF"); INSERT INTO rose_db_object_test_products ( id, name, category_id, status, published, last_modified, date_created ) VALUES (?, ?, ?, ?, ?, ?, ?) EOF $sth->execute($i + 500_000, "Product $i", 2, 'temp', '2005-01-02 12:34:56', '2005-02-02 12:34:56', '2005-03-02 12:34:56'); $i++; } } INSERT_SIMPLE_PRODUCT_RDBO: { my $i = 1; sub insert_simple_product_rdbo { my $p = MyTest::RDBO::Simple::Product->new( db => $DB, id => $i + 100_000, name => "Product $i", category_id => 2, status => 'temp', published => '2005-01-02 12:34:56', last_modified => '2005-02-02 12:34:56', date_created => '2005-03-02 12:34:56'); $p->save; $i++; } } INSERT_SIMPLE_PRODUCT_CDBI: { my $i = 1; sub insert_simple_product_cdbi { MyTest::CDBI::Simple::Product->create({ id => $i + 200_000, name => "Product $i", category_id => 2, status => 'temp', published => '2005-01-02 12:34:56', last_modified => '2005-02-02 12:34:56', date_created => '2005-03-02 12:34:56' }); $i++; } } INSERT_SIMPLE_PRODUCT_CDBS: { my $i = 1; sub insert_simple_product_cdbs { MyTest::CDBI::Sweet::Simple::Product->create({ id => $i + 400_000, name => "Product $i", category_id => 2, status => 'temp', published => '2005-01-02 12:34:56', last_modified => '2005-02-02 12:34:56', date_created => '2005-03-02 12:34:56' }); $i++; } } INSERT_SIMPLE_PRODUCT_DBIC: { my $i = 1; sub insert_simple_product_dbic { #MyTest::DBIC::Schema::Simple::Product->create({ $DBIC_Simple_Product_RS->create({ id => $i + 300_000, name => "Product $i", category_id => 2, status => 'temp', published => '2005-01-02 12:34:56', last_modified => '2005-02-02 12:34:56', date_created => '2005-03-02 12:34:56' }); $i++; } } # # Accessor # use constant ACCESSOR_ITERATIONS => 10_000; ACCCESSOR_SIMPLE_CATEGORY_DBI: { sub accessor_simple_category_dbi { my $sth = $DBH->prepare('SELECT id, name FROM rose_db_object_test_categories WHERE id = ?'); $sth->execute(1 + 500_000); my $c = $sth->fetchrow_hashref; # Use hash key access to simulate accessor methods for(1 .. ACCESSOR_ITERATIONS) { for(qw(id name)) { my $v = $c->{$_}; } } } } ACCCESSOR_SIMPLE_CATEGORY_RDBO: { sub accessor_simple_category_rdbo { my $c = MyTest::RDBO::Simple::Category->new( db => $DB, id => 1 + 100_000); $c->load; for(1 .. ACCESSOR_ITERATIONS) { for(qw(id name)) { $c->$_(); } } } } ACCCESSOR_SIMPLE_CATEGORY_CDBI: { sub accessor_simple_category_cdbi { my $c = MyTest::CDBI::Simple::Category->retrieve(1 + 200_000); for(1 .. ACCESSOR_ITERATIONS) { for(qw(id name)) { $c->$_(); } } } } ACCCESSOR_SIMPLE_CATEGORY_CDBS: { sub accessor_simple_category_cdbs { my $c = MyTest::CDBI::Sweet::Simple::Category->retrieve(1 + 400_000); for(1 .. ACCESSOR_ITERATIONS) { for(qw(id name)) { $c->$_(); } } } } ACCCESSOR_SIMPLE_CATEGORY_DBIC: { sub accessor_simple_category_dbic { #my $c = MyTest::DBIC::Schema::Simple::Category->find(1 + 300_000); my $c = $DBIC_Simple_Category_RS->single({ id => 1 + 300_000 }); for(1 .. ACCESSOR_ITERATIONS) { for(qw(id name)) { $c->$_(); } } } } ACCCESSOR_SIMPLE_PRODUCT_DBI: { sub accessor_simple_product_dbi { my $sth = $DBH->prepare(<<"EOF"); SELECT id, name, status, fk1, fk2, fk3, published, last_modified, date_created FROM rose_db_object_test_products WHERE id = ? EOF $sth->execute(1 + 500_000); my $p = $sth->fetchrow_hashref; # Use hash key access to simulate accessor methods for(1 .. ACCESSOR_ITERATIONS) { for(qw(id name status fk1 fk2 fk3 published last_modified date_created)) { my $v = $p->{$_}; } } } } ACCCESSOR_SIMPLE_PRODUCT_RDBO: { sub accessor_simple_product_rdbo { my $p = MyTest::RDBO::Simple::Product->new( db => $DB, id => 1 + 100_000); $p->load; for(1 .. ACCESSOR_ITERATIONS) { for(qw(id name status fk1 fk2 fk3 published last_modified date_created)) { $p->$_(); } } } } ACCCESSOR_SIMPLE_PRODUCT_CDBI: { sub accessor_simple_product_cdbi { my $p = MyTest::CDBI::Simple::Product->retrieve(1 + 200_000); for(1 .. ACCESSOR_ITERATIONS) { for(qw(id name status fk1 fk2 fk3 published last_modified date_created)) { $p->$_(); } } } } ACCCESSOR_SIMPLE_PRODUCT_CDBS: { sub accessor_simple_product_cdbs { my $p = MyTest::CDBI::Sweet::Simple::Product->retrieve(1 + 400_000); for(1 .. ACCESSOR_ITERATIONS) { for(qw(id name status fk1 fk2 fk3 published last_modified date_created)) { $p->$_(); } } } } ACCCESSOR_SIMPLE_PRODUCT_DBIC: { sub accessor_simple_product_dbic { #my $p = MyTest::DBIC::Schema::Simple::Product->find(1 + 300_000); my $p = $DBIC_Simple_Product_RS->single({ id => 1 + 300_000 }); for(1 .. ACCESSOR_ITERATIONS) { for(qw(id name status fk1 fk2 fk3 published last_modified date_created)) { $p->$_(); } } } } # # Load # LOAD_SIMPLE_CATEGORY_DBI: { my $i = 1; sub load_simple_category_dbi { my $sth = $DBH->prepare('SELECT id, name FROM rose_db_object_test_categories WHERE id = ?'); $sth->execute($i + 500_000); my $c = $sth->fetchrow_hashref; $i++; } } LOAD_SIMPLE_CATEGORY_RDBO: { my $i = 1; sub load_simple_category_rdbo { my $c = MyTest::RDBO::Simple::Category->new( db => $DB, id => $i + 100_000); $c->load; $i++; } } LOAD_SIMPLE_CATEGORY_CDBI: { my $i = 1; sub load_simple_category_cdbi { my $c = MyTest::CDBI::Simple::Category->retrieve($i + 200_000); $i++; } } LOAD_SIMPLE_CATEGORY_CDBS: { my $i = 1; sub load_simple_category_cdbs { my $c = MyTest::CDBI::Sweet::Simple::Category->retrieve($i + 400_000); $i++; } } LOAD_SIMPLE_CATEGORY_DBIC: { my $i = 1; sub load_simple_category_dbic { #my $c = MyTest::DBIC::Schema::Simple::Category->find($i + 300_000); my $c = $DBIC_Simple_Category_RS->single({ id => $i + 300_000 }); $i++; } } LOAD_SIMPLE_PRODUCT_DBI: { my $i = 1; sub load_simple_product_dbi { my $sth = $DBH->prepare('SELECT id, name, category_id, status, fk1, fk2, fk3, published, last_modified, date_created FROM rose_db_object_test_products WHERE id = ?'); $sth->execute($i + 500_000); my %row; $sth->bind_columns(\@row{qw(id name category_id status fk1 fk2 fk3 published last_modified date_created)}); $sth->fetch; $i++; } } LOAD_SIMPLE_PRODUCT_RDBO: { my $i = 1; sub load_simple_product_rdbo { my $p = MyTest::RDBO::Simple::Product->new( db => $DB, id => $i + 100_000); $p->load; $i++; } } LOAD_SIMPLE_PRODUCT_CDBI: { my $i = 1; sub load_simple_product_cdbi { my $c = MyTest::CDBI::Simple::Product->retrieve($i + 200_000); $i++; } } LOAD_SIMPLE_PRODUCT_CDBS: { my $i = 1; sub load_simple_product_cdbs { my $c = MyTest::CDBI::Sweet::Simple::Product->retrieve($i + 400_000); $i++; } } LOAD_SIMPLE_PRODUCT_DBIC: { my $i = 1; sub load_simple_product_dbic { #my $c = MyTest::DBIC::Schema::Simple::Product->find($i + 300_000); my $c = $DBIC_Simple_Product_RS->single({ id => $i + 300_000 }); $i++; } } LOAD_SIMPLE_PRODUCT_AND_CATEGORY_DBI: { my $i = 1; sub load_simple_product_and_category_dbi { my $sth = $DBH->prepare(<<"EOF"); SELECT p.id, p.name, p.category_id, p.status, p.fk1, p.fk2, p.fk3, p.published, p.last_modified, p.date_created, c.id, c.name FROM rose_db_object_test_products p, rose_db_object_test_categories c WHERE c.id = p.category_id AND p.id = ? EOF $sth->execute($i + 500_000); my %row; $sth->bind_columns(\@row{qw(id name category_id status fk1 fk2 fk3 published last_modified date_created cat_id cat_name)}); $sth->fetch; my $n = $row{'cat_name'}; die unless($n =~ /\S/); $i++; } } LOAD_SIMPLE_PRODUCT_AND_CATEGORY_RDBO: { my $i = 1; sub load_simple_product_and_category_rdbo { my $p = MyTest::RDBO::Simple::Product->new( db => $DB, id => $i + 100_000); $p->load;#(with => [ 'category' ], inject_results => 1, prepare_cached => 1); my $cat = $p->category; my $n = $cat->name; die unless($n =~ /\S/); $i++; } } LOAD_SIMPLE_PRODUCT_AND_CATEGORY_CDBI: { my $i = 1; sub load_simple_product_and_category_cdbi { my $c = MyTest::CDBI::Simple::Product->retrieve($i + 200_000); my $cat = $c->category_id; my $n = $cat->name; die unless($n =~ /\S/); $i++; } } LOAD_SIMPLE_PRODUCT_AND_CATEGORY_CDBS: { my $i = 1; sub load_simple_product_and_category_cdbs { my $c = MyTest::CDBI::Sweet::Simple::Product->retrieve($i + 400_000); my $cat = $c->category_id; my $n = $cat->name; die unless($n =~ /\S/); $i++; } } LOAD_SIMPLE_PRODUCT_AND_CATEGORY_DBIC: { my $i = 1; sub load_simple_product_and_category_dbic { #my $c = MyTest::DBIC::Schema::Simple::Product->find($i + 300_000); my $c = $DBIC_Simple_Product_RS->single({ id => $i + 300_000 }); my $cat = $c->category_id; my $n = $cat->name; die unless($n =~ /\S/); $i++; } } # # Update # UPDATE_SIMPLE_CATEGORY_DBI: { my $i = 1; sub update_simple_category_dbi { my $sth = $DBH->prepare('SELECT id, name FROM rose_db_object_test_categories WHERE id = ?'); $sth->execute($i + 500_000); my($id, $name); $sth->bind_columns(\$id, \$name); $sth->fetch; $name .= ' updated'; my $usth = $DBH->prepare('UPDATE rose_db_object_test_categories SET name = ? WHERE id = ?'); $usth->execute($name, $id); $i++; } } UPDATE_SIMPLE_CATEGORY_RDBO: { my $i = 1; sub update_simple_category_rdbo { my $c = MyTest::RDBO::Simple::Category->new( db => $DB, id => $i + 100_000); $c->load; $c->name($c->name . ' updated'); $c->save; $i++; } } UPDATE_SIMPLE_CATEGORY_CDBI: { my $i = 1; sub update_simple_category_cdbi { my $c = MyTest::CDBI::Simple::Category->retrieve($i + 200_000); $c->name($c->name . ' updated'); $c->update; $i++; } } UPDATE_SIMPLE_CATEGORY_CDBS: { my $i = 1; sub update_simple_category_cdbs { my $c = MyTest::CDBI::Sweet::Simple::Category->retrieve($i + 400_000); $c->name($c->name . ' updated'); $c->update; $i++; } } UPDATE_SIMPLE_CATEGORY_DBIC: { my $i = 1; sub update_simple_category_dbic { #my $c = MyTest::DBIC::Schema::Simple::Category->find($i + 300_000); my $c = $DBIC_Simple_Category_RS->single({ id => $i + 300_000 }); $c->name($c->name . ' updated'); $c->update; $i++; } } UPDATE_SIMPLE_PRODUCT_DBI: { my $i = 1; sub update_simple_product_dbi { my $sth = $DBH->prepare('SELECT id, name, category_id, status, fk1, fk2, fk3, published, last_modified, date_created FROM rose_db_object_test_products WHERE id = ?'); $sth->execute($i + 500_000); my %row; $sth->bind_columns(\@row{qw(id name category_id status fk1 fk2 fk3 published last_modified date_created)}); $sth->fetch; $row{'name'} .= ' updated'; my $usth = $DBH->prepare('UPDATE rose_db_object_test_products SET name = ? WHERE id = ?'); $usth->execute($row{'name'}, $i + 500_000); $i++; } } UPDATE_SIMPLE_PRODUCT_RDBO: { my $i = 1; sub update_simple_product_rdbo { my $p = MyTest::RDBO::Simple::Product->new( db => $DB, id => $i + 100_000); $p->load; $p->name($p->name . ' updated'); $p->save; $i++; } } UPDATE_SIMPLE_PRODUCT_CDBI: { my $i = 1; sub update_simple_product_cdbi { my $p = MyTest::CDBI::Simple::Product->retrieve($i + 200_000); $p->name($p->name . ' updated'); $p->update; $i++; } } UPDATE_SIMPLE_PRODUCT_CDBS: { my $i = 1; sub update_simple_product_cdbs { my $p = MyTest::CDBI::Sweet::Simple::Product->retrieve($i + 400_000); $p->name($p->name . ' updated'); $p->update; $i++; } } UPDATE_SIMPLE_PRODUCT_DBIC: { my $i = 1; sub update_simple_product_dbic { #my $p = MyTest::DBIC::Schema::Simple::Product->find($i + 300_000); my $p = $DBIC_Simple_Product_RS->single({ id => $i + 300_000 }); $p->name($p->name . ' updated'); $p->update; $i++; } } # # Search # SEARCH_SIMPLE_CATEGORY_DBI: { my $printed = 0; sub search_simple_category_dbi { my $sth = $DBH->prepare(<<"EOF"); SELECT id, name FROM rose_db_object_test_categories WHERE name LIKE 'xCat %2%' AND id <= @{[ 500_000 + $Iterations ]} AND id >= 500000 LIMIT @{[ LIMIT ]} EOF $sth->execute; my $c = $sth->fetchall_arrayref; die unless(@$c); if($Debug && !$printed) { print "search_simple_category_dbi GOT ", scalar(@$c), "\n"; $printed++; } } } SEARCH_SIMPLE_CATEGORY_RDBO: { my $printed = 0; sub search_simple_category_rdbo { my $c = MyTest::RDBO::Simple::Category::Manager->get_categories( db => $DB, query_is_sql => 1, prepare_cached => 1, inject_results => 1, query => [ id => { le => 100_000 + $Iterations }, id => { ge => 100_000 }, name => { like => 'xCat %2%' }, ], limit => LIMIT); die unless(@$c); if($Debug && !$printed) { print "search_simple_category_rdbo GOT ", scalar(@$c), "\n"; $printed++; } } } SEARCH_SIMPLE_CATEGORY_CDBI: { my $printed = 0; sub search_simple_category_cdbi { my @c = MyTest::CDBI::Simple::Category->search_where( { name => { -like => 'xCat %2%' }, id => { '<=' => 200_000 + $Iterations, '>=' => 200_000 }, }, { limit_dialect => $Limit_Dialect, limit => LIMIT }); die unless(@c); if($Debug && !$printed) { print "search_simple_category_cdbi GOT ", scalar(@c), "\n"; $printed++; } } } SEARCH_SIMPLE_CATEGORY_CDBS: { my $printed = 0; sub search_simple_category_cdbs { my @c = MyTest::CDBI::Sweet::Simple::Category->search_where( { name => { -like => 'xCat %2%' }, id => { '<=' => 400_000 + $Iterations, '>=' => 400_000 } }, { limit_dialect => $Limit_Dialect, limit => LIMIT }); die unless(@c); if($Debug && !$printed) { print "search_simple_category_cdbs GOT ", scalar(@c), "\n"; $printed++; } } } SEARCH_SIMPLE_CATEGORY_DBIC: { my $printed = 0; sub search_simple_category_dbic { my @c = #MyTest::DBIC::Schema::Simple::Category->search( $DBIC_Simple_Category_RS->search( { name => { -like => 'xCat %2%' }, id => { '<=' => 300_000 + $Iterations, '>=' => 300_000 } }, { rows => LIMIT}); die unless(@c); if($Debug && !$printed) { print "search_simple_category_dbic GOT ", scalar(@c), "\n"; $printed++; } } } SEARCH_SIMPLE_PRODUCT_DBI: { my $printed = 0; sub search_simple_product_dbi { my $sth = $DBH->prepare(<<"EOF"); SELECT id, name, category_id, status, fk1, fk2, fk3, published, last_modified, date_created FROM rose_db_object_test_products WHERE name LIKE 'Product %2%' AND id <= @{[ 500_000 + $Iterations ]} AND id >= 500000 LIMIT @{[ LIMIT ]} EOF $sth->execute; my $p = $sth->fetchall_arrayref; die unless(@$p); if($Debug && !$printed) { print "search_simple_product_dbi GOT ", scalar(@$p), "\n"; $printed++; } } } SEARCH_SIMPLE_PRODUCT_RDBO: { my $printed = 0; sub search_simple_product_rdbo { my $p = MyTest::RDBO::Simple::Product::Manager->get_products( db => $DB, query_is_sql => 1, prepare_cached => 1, inject_results => 1, query => [ name => { like => 'Product %2%' }, id => { le => 100_000 + $Iterations }, id => { ge => 100_000 }, ], limit => LIMIT); die unless(@$p); if($Debug && !$printed) { print "search_simple_product_rdbo GOT ", scalar(@$p), "\n"; $printed++; } } } SEARCH_SIMPLE_PRODUCT_CDBI: { my $printed = 0; sub search_simple_product_cdbi { my @p = MyTest::CDBI::Simple::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 200_000 + $Iterations, '>=' => 200_000 }, }, { limit_dialect => $Limit_Dialect, limit => LIMIT }); die unless(@p); if($Debug && !$printed) { print "search_simple_product_cdbi GOT ", scalar(@p), "\n"; $printed++; } } } SEARCH_SIMPLE_PRODUCT_CDBS: { my $printed = 0; sub search_simple_product_cdbs { my @p = MyTest::CDBI::Sweet::Simple::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 400_000 + $Iterations, '>=' => 400_000 } }, { limit_dialect => $Limit_Dialect, limit => LIMIT }); die unless(@p); if($Debug && !$printed) { print "search_simple_product_cdbs GOT ", scalar(@p), "\n"; $printed++; } } } SEARCH_SIMPLE_PRODUCT_DBIC: { my $printed = 0; sub search_simple_product_dbic { my @p = #MyTest::DBIC::Schema::Simple::Product->search( $DBIC_Simple_Product_RS->search( { name => { -like => 'Product %2%' }, id => { '<=' => 300_000 + $Iterations, '>=' => 300_000 } }, { rows => LIMIT}); die unless(@p); if($Debug && !$printed) { print "search_simple_product_dbic GOT ", scalar(@p), "\n"; $printed++; } } } SEARCH_SIMPLE_PRODUCT_AND_CATEGORY_DBI: { my $printed = 0; sub search_simple_product_and_category_dbi { my $sth = $DBH->prepare(<<"EOF"); SELECT p.id, p.name, p.category_id, p.status, p.fk1, p.fk2, p.fk3, p.published, p.last_modified, p.date_created, c.id, c.name FROM rose_db_object_test_products p, rose_db_object_test_categories c WHERE c.id = p.category_id AND p.name LIKE 'Product %2%' AND p.id <= @{[ 500_000 + $Iterations ]} AND p.id >= 500000 LIMIT @{[ LIMIT ]} EOF $sth->execute; my %row; $sth->bind_columns(\@row{qw(id name category_id status fk1 fk2 fk3 published last_modified date_created cat_id cat_name)}); my @ps; while($sth->fetch) { push(@ps, { %row }); } die unless(@ps); if($Debug && !$printed) { print "search_simple_product_and_category_dbi GOT ", scalar(@ps), "\n"; $printed++; } foreach my $p (@ps) { my $n = $p->{'cat_name'}; die unless($n =~ /\S/); } } } SEARCH_SIMPLE_PRODUCT_AND_CATEGORY_RDBO: { my $printed = 0; sub search_simple_product_and_category_rdbo { my $ps = MyTest::RDBO::Simple::Product::Manager->get_products( db => $DB, query_is_sql => 1, prepare_cached => 1, inject_results => 1, query => [ id => { le => 100_000 + $Iterations }, id => { ge => 100_000 }, name => { like => 'Product %2%' }, ], require_objects => [ 'category' ], limit => LIMIT); die unless(@$ps); if($Debug && !$printed) { print "search_simple_product_and_category_rdbo GOT ", scalar(@$ps), "\n"; $printed++; } foreach my $p (@$ps) { my $cat = $p->category; my $n = $cat->name; die unless($n =~ /\S/); } } } SEARCH_SIMPLE_PRODUCT_AND_CATEGORY_CDBI: { my $printed = 0; sub search_simple_product_and_category_cdbi { my @p = MyTest::CDBI::Simple::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 200_000 + $Iterations, '>=' => 200_000 } }, { limit_dialect => $Limit_Dialect, limit => LIMIT }); die unless(@p); if($Debug && !$printed) { print "search_simple_product_and_category_cdbi GOT ", scalar(@p), "\n"; $printed++; } foreach my $p (@p) { my $cat = $p->category_id; my $n = $cat->name; die unless($n =~ /\S/); } } } SEARCH_SIMPLE_PRODUCT_AND_CATEGORY_CDBS: { my $printed = 0; sub search_simple_product_and_category_cdbs { my @p = MyTest::CDBI::Sweet::Simple::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 400_000 + $Iterations, '>=' => 400_000 } }, { prefetch => [ 'category_id' ], limit_dialect => $Limit_Dialect, limit => LIMIT }); die unless(@p); if($Debug && !$printed) { print "search_simple_product_and_category_cdbs GOT ", scalar(@p), "\n"; $printed++; } foreach my $p (@p) { my $cat = $p->category_id; my $n = $cat->name; die unless($n =~ /\S/); } } } SEARCH_SIMPLE_PRODUCT_AND_CATEGORY_DBIC: { my $printed = 0; sub search_simple_product_and_category_dbic { my @p = #MyTest::DBIC::Schema::Simple::Product->search( $DBIC_Simple_Product_RS->search( { 'me.name' => { -like => 'Product %2%' }, 'me.id' => { '<=' => 300_000 + $Iterations, '>=' => 300_000 } }, { prefetch => [ 'category_id' ], rows => LIMIT}); die unless(@p); if($Debug && !$printed) { print "search_simple_product_and_category_dbic GOT ", scalar(@p), "\n"; $printed++; } foreach my $p (@p) { my $cat = $p->category_id; my $n = $cat->name; die unless($n =~ /\S/); } } } # # Search with 1-to-1 and 1-to-n sub-objects # SEARCH_SIMPLE_PRODUCT_AND_CATEGORY_AND_CODE_NAMES_DBI: { my $printed = 0; sub search_simple_product_and_category_and_code_name_dbi { my $sth = $DBH->prepare(<<"EOF"); SELECT p.id, p.name, p.category_id, p.status, p.fk1, p.fk2, p.fk3, p.published, p.last_modified, p.date_created, c.id, c.name, n.id, n.product_id, n.name FROM rose_db_object_test_products p LEFT OUTER JOIN rose_db_object_test_code_names n ON(n.product_id = p.id), rose_db_object_test_categories c WHERE c.id = p.category_id AND n.product_id = p.id AND p.name LIKE 'Product %2%' AND p.id <= @{[ 500_000 + $Iterations ]} AND p.id >= 500000 EOF #LIMIT @{[ MAX_LIMIT ]} $sth->execute; my %row; $sth->bind_columns(\@row{qw(id name category_id status fk1 fk2 fk3 published last_modified date_created cat_id cat_name cn_id cn_product_id cn_name)}); my @ps; while($sth->fetch) { push(@ps, { %row }); } die unless(@ps); if($Debug && !$printed) { my(%seen, $num); foreach my $p (@ps) { $num++ unless($seen{$p->{'id'}}++); } print "search_simple_product_and_category_and_code_name_dbi GOT $num\n"; $printed++; } foreach my $p (@ps) { my $n = $p->{'cat_name'}; die unless($n =~ /\S/); my $cn = $p->{'cn_name'}; die unless(index($cn, 'CN ') == 0); } } } SEARCH_SIMPLE_PRODUCT_AND_CATEGORY_AND_CODE_NAMES_RDBO: { my $printed = 0; sub search_simple_product_and_category_and_code_name_rdbo { #local $Rose::DB::Object::Manager::Debug = 1; my $ps = MyTest::RDBO::Simple::Product::Manager->get_products( db => $DB, query_is_sql => 1, prepare_cached => 1, inject_results => 1, query => [ id => { le => 100_000 + $Iterations }, id => { ge => 100_000 }, name => { like => 'Product %2%' }, ], with_objects => [ 'code_names' ], require_objects => [ 'category' ]); #limit => MAX_LIMIT); die unless(@$ps); if($Debug && !$printed) { print "search_simple_product_and_category_and_code_name_rdbo GOT ", scalar(@$ps), "\n"; $printed++; } foreach my $p (@$ps) { my $cat = $p->category; my $n = $cat->name; die unless($n =~ /\S/); foreach my $cn ($p->code_names) { die unless(index($cn->name, 'CN ') == 0); } #print "R P $p->{'id'} C $cat->{'name'} CN ", scalar(@{[ $p->code_names ]}), "\n"; } } } SEARCH_SIMPLE_PRODUCT_AND_CATEGORY_AND_CODE_NAMES_CDBI: { my $printed = 0; sub search_simple_product_and_category_and_code_name_cdbi { my @p = MyTest::CDBI::Simple::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 200_000 + $Iterations, '>=' => 200_000 } } #{ limit_dialect => $Limit_Dialect, limit => MAX_LIMIT } ); die unless(@p); if($Debug && !$printed) { print "search_simple_product_and_category_and_code_name_cdbi GOT ", scalar(@p), "\n"; $printed++; } foreach my $p (@p) { my $cat = $p->category_id; my $n = $cat->name; die unless($n =~ /\S/); foreach my $cn ($p->code_names) { die unless(index($cn->name, 'CN ') == 0); } } } } SEARCH_SIMPLE_PRODUCT_AND_CATEGORY_AND_CODE_NAMES_CDBS: { my $printed = 0; sub search_simple_product_and_category_and_code_name_cdbs { my @p = MyTest::CDBI::Sweet::Simple::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 400_000 + $Iterations, '>=' => 400_000 } }, { prefetch => [ 'category_id' ], #limit_dialect => $Limit_Dialect, limit => MAX_LIMIT }); die unless(@p); if($Debug && !$printed) { print "search_simple_product_and_category_and_code_name_cdbs GOT ", scalar(@p), "\n"; $printed++; } foreach my $p (@p) { my $cat = $p->category_id; my $n = $cat->name; die unless($n =~ /\S/); foreach my $cn ($p->code_names) { die unless(index($cn->name, 'CN ') == 0); } } } } SEARCH_SIMPLE_PRODUCT_AND_CATEGORY_AND_CODE_NAMES_DBIC: { my $printed = 0; sub search_simple_product_and_category_and_code_name_dbic { my @p = #MyTest::DBIC::Schema::Simple::Product->search( $DBIC_Simple_Product_RS->search( { 'me.name' => { -like => 'Product %2%' }, 'me.id' => { '<=' => 300_000 + $Iterations, '>=' => 300_000 } }, { prefetch => [ 'code_names', 'category_id' ], #software_limit => 1, #rows => MAX_LIMIT, }); die unless(@p); if($Debug && !$printed) { print "search_simple_product_and_category_and_code_name_dbic GOT ", scalar(@p), "\n"; $printed++; } foreach my $p (@p) { my $cat = $p->category_id; my $n = $cat->name; die unless($n =~ /\S/); my $rs = $p->code_names; foreach my $cn ($rs->all) { die unless(index($cn->name, 'CN ') == 0); } #print "D P ", $p->id, " C ", $cat->name, " CN $rs\n"; } } } # # Search with limit and offset # SEARCH_LIMIT_OFFSET_SIMPLE_PRODUCT_DBI: { my $printed = 0; sub search_limit_offset_simple_product_dbi { my $sth = $DBH->prepare(<<"EOF"); SELECT id, name, category_id, status, fk1, fk2, fk3, published, last_modified, date_created, id, name FROM rose_db_object_test_products WHERE name LIKE 'Product %2%' AND id <= @{[ 500_000 + $Iterations ]} AND id >= 500000 LIMIT @{[LIMIT]} OFFSET @{[OFFSET]} EOF $sth->execute; my $ps = $sth->fetchall_arrayref; if($Debug && !$printed) { print "search_limit_offset_simple_product_dbi GOT ", scalar(@$ps), "\n"; $printed++; } } } SEARCH_LIMIT_OFFSET_SIMPLE_PRODUCT_RDBO: { my $printed = 0; sub search_limit_offset_simple_product_rdbo { my $p = MyTest::RDBO::Simple::Product::Manager->get_products( db => $DB, query_is_sql => 1, prepare_cached => 1, inject_results => 1, query => [ id => { le => 100_000 + $Iterations }, id => { ge => 100_000 }, name => { like => 'Product %2%' }, ], limit => LIMIT, offset => OFFSET); #die unless(@$p); if($Debug && !$printed) { print "search_limit_offset_simple_product_rdbo GOT ", scalar(@$p), "\n"; $printed++; } } } SEARCH_LIMIT_OFFSET_SIMPLE_PRODUCT_CDBI: { my $printed = 0; sub search_limit_offset_simple_product_cdbi { die "Unsupported"; my @p = MyTest::CDBI::Complex::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 200_000 + $Iterations, '>=' => 200_000 } }, { limit_dialect => $Limit_Dialect, limit => LIMIT, offset => OFFSET }); die unless(@p); if($Debug && !$printed) { print "search_limit_offset_simple_product_cdbi GOT ", scalar(@p), "\n"; $printed++; } } } SEARCH_LIMIT_OFFSET_SIMPLE_PRODUCT_CDBS: { my $printed = 0; sub search_limit_offset_simple_product_cdbs { my @p = MyTest::CDBI::Sweet::Simple::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 400_000 + $Iterations, '>=' => 400_000 } }, { limit_dialect => $Limit_Dialect, limit => LIMIT, offset => OFFSET }); die unless(@p); if($Debug && !$printed) { print "search_limit_offset_simple_product_cdbs GOT ", scalar(@p), "\n"; $printed++; } } } SEARCH_LIMIT_OFFSET_SIMPLE_PRODUCT_DBIC: { my $printed = 0; sub search_limit_offset_simple_product_dbic { my @p = #MyTest::DBIC::Schema::Simple::Product->search( $DBIC_Simple_Product_RS->search( { 'me.name' => { -like => 'Product %2%' }, 'me.id' => { '<=' => 300_000 + $Iterations, '>=' => 300_000 } }, { rows => LIMIT, offset => OFFSET }); die unless(@p); if($Debug && !$printed) { print "search_limit_offset_simple_product_dbic GOT ", scalar(@p), "\n"; $printed++; } } } # # Iterate # ITERATE_SIMPLE_CATEGORY_DBI: { my $printed = 0; sub iterate_simple_category_dbi { my $sth = $DBH->prepare(<<"EOF"); SELECT id, name FROM rose_db_object_test_categories WHERE name LIKE 'xCat %2%' AND id <= @{[ 500_000 + $Iterations ]} AND id >= 500000 LIMIT @{[ LIMIT ]} EOF $sth->execute; my($id, $name); $sth->bind_columns(\$id, \$name); my $i = 0; while($sth->fetch) { $i++; } if($Debug && !$printed) { print "iterate_simple_category_dbi GOT $i\n"; $printed++; } } } ITERATE_SIMPLE_CATEGORY_RDBO: { my $printed = 0; sub iterate_simple_category_rdbo { my $iter = MyTest::RDBO::Simple::Category::Manager->get_categories_iterator( db => $DB, query_is_sql => 1, prepare_cached => 1, query => [ id => { le => 100_000 + $Iterations }, id => { ge => 100_000 }, name => { like => 'xCat %2%' }, ], limit => LIMIT); my $i = 0; while(my $c = $iter->next) { $i++; } if($Debug && !$printed) { print "iterate_simple_category_rdbo GOT $i\n"; $printed++; } } } ITERATE_SIMPLE_CATEGORY_CDBI: { my $printed = 0; sub iterate_simple_category_cdbi { my $iter = MyTest::CDBI::Simple::Category->search_where( { name => { -like => 'xCat %2%' }, id => { '<=' => 200_000 + $Iterations, '>=' => 200_000 }, }, { limit_dialect => $Limit_Dialect, limit => LIMIT }); my $i = 0; while(my $c = $iter->next) { $i++; } if($Debug && !$printed) { print "iterate_simple_category_cdbi GOT $i\n"; $printed++; } } } ITERATE_SIMPLE_CATEGORY_CDBS: { my $printed = 0; sub iterate_simple_category_cdbs { my $iter = MyTest::CDBI::Sweet::Simple::Category->search_where( { name => { -like => 'xCat %2%' }, id => { '<=' => 400_000 + $Iterations, '>=' => 400_000 } }, { limit_dialect => $Limit_Dialect, limit => LIMIT }); my $i = 0; while(my $c = $iter->next) { $i++; } if($Debug && !$printed) { print "iterate_simple_category_cdbs GOT $i\n"; $printed++; } } } ITERATE_SIMPLE_CATEGORY_DBIC: { my $printed = 0; sub iterate_simple_category_dbic { my $iter = #MyTest::DBIC::Schema::Simple::Category->search( $DBIC_Simple_Category_RS->search( { name => { -like => 'xCat %2%' }, id => { '<=' => 300_000 + $Iterations, '>=' => 300_000 } }, { rows => LIMIT}); my $i = 0; while(my $c = $iter->next) { $i++; } if($Debug && !$printed) { print "iterate_simple_category_dbic GOT $i\n"; $printed++; } } } ITERATE_SIMPLE_PRODUCT_DBI: { my $printed = 0; sub iterate_simple_product_dbi { my $sth = $DBH->prepare(<<"EOF"); SELECT id, name, category_id, status, fk1, fk2, fk3, published, last_modified, date_created FROM rose_db_object_test_products WHERE name LIKE 'Product %2%' AND id <= @{[ 500_000 + $Iterations ]} AND id >= 500000 LIMIT @{[ LIMIT ]} EOF $sth->execute; my %row; $sth->bind_columns(\@row{qw(id name category_id status fk1 fk2 fk3 published last_modified date_created)}); my $i = 0; while($sth->fetch) { $i++; } if($Debug && !$printed) { print "iterate_simple_product_dbi GOT $i\n"; $printed++; } } } ITERATE_SIMPLE_PRODUCT_RDBO: { my $printed = 0; sub iterate_simple_product_rdbo { my $iter = MyTest::RDBO::Simple::Product::Manager->get_products_iterator( db => $DB, query_is_sql => 1, prepare_cached => 1, query => [ id => { le => 100_000 + $Iterations }, id => { ge => 100_000 }, name => { like => 'Product %2%' }, ], limit => LIMIT); my $i = 0; while(my $p = $iter->next) { $i++; } if($Debug && !$printed) { print "iterate_simple_product_rdbo GOT $i\n"; $printed++; } } } ITERATE_SIMPLE_PRODUCT_CDBI: { my $printed = 0; sub iterate_simple_product_cdbi { my $iter = MyTest::CDBI::Simple::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 200_000 + $Iterations, '>=' => 200_000 } }, { limit_dialect => $Limit_Dialect, limit => LIMIT }); my $i = 0; while(my $p = $iter->next) { $i++; } if($Debug && !$printed) { print "iterate_simple_product_cdbi GOT $i\n"; $printed++; } } } ITERATE_SIMPLE_PRODUCT_CDBS: { my $printed = 0; sub iterate_simple_product_cdbs { my $iter = MyTest::CDBI::Sweet::Simple::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 400_000 + $Iterations, '>=' => 400_000 } }, { limit_dialect => $Limit_Dialect, limit => LIMIT }); my $i = 0; while(my $p = $iter->next) { $i++; } if($Debug && !$printed) { print "iterate_simple_product_cdbs GOT $i\n"; $printed++; } } } ITERATE_SIMPLE_PRODUCT_DBIC: { my $printed = 0; sub iterate_simple_product_dbic { my $iter = #MyTest::DBIC::Schema::Simple::Product->search( $DBIC_Simple_Product_RS->search( { name => { -like => 'Product %2%' }, id => { '<=' => 300_000 + $Iterations, '>=' => 300_000 } }, { rows => LIMIT}); my $i = 0; while(my $p = $iter->next) { $i++; } if($Debug && !$printed) { print "iterate_simple_product_dbic GOT $i\n"; $printed++; } } } ITERATE_SIMPLE_PRODUCT_AND_CATEGORY_DBI: { my $printed = 0; sub iterate_simple_product_and_category_dbi { my $sth = $DBH->prepare(<<"EOF"); SELECT p.id, p.name, p.category_id, p.status, p.fk1, p.fk2, p.fk3, p.published, p.last_modified, p.date_created, c.id, c.name FROM rose_db_object_test_products p, rose_db_object_test_categories c WHERE c.id = p.category_id AND p.name LIKE 'Product %2%' AND p.id <= @{[ 500_000 + $Iterations ]} AND p.id >= 500000 LIMIT @{[ LIMIT ]} EOF $sth->execute; my %row; $sth->bind_columns(\@row{qw(id name category_id status fk1 fk2 fk3 published last_modified date_created cat_id cat_name)}); my $i = 0; while($sth->fetch) { $i++; my $n = $row{'cat_name'}; die unless($n =~ /\S/); } if($Debug && !$printed) { print "iterate_simple_product_and_category_dbi GOT $i\n"; $printed++; } } } ITERATE_SIMPLE_PRODUCT_AND_CATEGORY_RDBO: { my $printed = 0; sub iterate_simple_product_and_category_rdbo { my $iter = MyTest::RDBO::Simple::Product::Manager->get_products_iterator( db => $DB, query_is_sql => 1, prepare_cached => 1, query => [ id => { le => 100_000 + $Iterations }, id => { ge => 100_000 }, name => { like => 'Product %2%' }, ], with_objects => [ 'category' ], limit => LIMIT); my $i = 0; while(my $p = $iter->next) { $i++; my $cat = $p->category; my $n = $cat->name; die unless($n =~ /\S/); } if($Debug && !$printed) { print "iterate_simple_product_and_category_rdbo GOT $i\n"; $printed++; } } } ITERATE_SIMPLE_PRODUCT_AND_CATEGORY_CDBI: { my $printed = 0; sub iterate_simple_product_and_category_cdbi { my $iter = MyTest::CDBI::Simple::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 200_000 + $Iterations, '>=' => 200_000 } }, { limit_dialect => $Limit_Dialect, limit => LIMIT }); my $i = 0; while(my $p = $iter->next) { $i++; my $cat = $p->category_id; my $n = $cat->name; die unless($n =~ /\S/); } if($Debug && !$printed) { print "iterate_simple_product_and_category_cdbi GOT $i\n"; $printed++; } } } ITERATE_SIMPLE_PRODUCT_AND_CATEGORY_CDBS: { my $printed = 0; sub iterate_simple_product_and_category_cdbs { my $iter = MyTest::CDBI::Sweet::Simple::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 400_000 + $Iterations, '>=' => 400_000 } }, { prefetch => [ 'category_id' ], limit_dialect => $Limit_Dialect, limit => LIMIT }); my $i = 0; while(my $p = $iter->next) { $i++; my $cat = $p->category_id; my $n = $cat->name; die unless($n =~ /\S/); } if($Debug && !$printed) { print "iterate_simple_product_and_category_cdbs GOT $i\n"; $printed++; } } } ITERATE_SIMPLE_PRODUCT_AND_CATEGORY_DBIC: { my $printed = 0; sub iterate_simple_product_and_category_dbic { my $iter = #MyTest::DBIC::Schema::Simple::Product->search( $DBIC_Simple_Product_RS->search( { 'me.name' => { -like => 'Product %2%' }, 'me.id' => { '<=' => 300_000 + $Iterations, '>=' => 300_000 } }, { prefetch => [ 'category_id' ], rows => LIMIT }); my $i = 0; while(my $p = $iter->next) { $i++; my $cat = $p->category_id; my $n = $cat->name; die unless($n =~ /\S/); } if($Debug && !$printed) { print "iterate_simple_product_and_category_dbic GOT $i\n"; $printed++; } } } # # Delete # DELETE_SIMPLE_CATEGORY_DBI: { my $i = 1; sub delete_simple_category_dbi { my $sth = $DBH->prepare('DELETE FROM rose_db_object_test_categories WHERE id = ?'); $sth->execute($i + 500_000); $i++; } } DELETE_SIMPLE_CATEGORY_RDBO: { my $i = 1; sub delete_simple_category_rdbo { my $c = MyTest::RDBO::Simple::Category->new( db => $DB, id => $i + 100_000); $c->delete(prepare_cached => $i > 1); $i++; } } DELETE_SIMPLE_CATEGORY_CDBI: { my $i = 1; sub delete_simple_category_cdbi { my $c = MyTest::CDBI::Simple::Category->retrieve($i + 200_000); $c->delete; $i++; } } DELETE_SIMPLE_CATEGORY_CDBS: { my $i = 1; sub delete_simple_category_cdbs { my $c = MyTest::CDBI::Sweet::Simple::Category->retrieve($i + 400_000); $c->delete; $i++; } } DELETE_SIMPLE_CATEGORY_DBIC: { my $i = 1; sub delete_simple_category_dbic { #my $c = MyTest::DBIC::Schema::Simple::Category->find($i + 300_000); my $c = $DBIC_Simple_Category_RS->single({ id => $i + 300_000 }); $c->delete; $i++; } } ## ## Complex ## # # Insert # # Using simple classes for some insert benchmarks because the complex # case for Rose::DB::Object differsw substantially in functionality from # the others. RDBO parses column values in the constructor, whereas the # others require that column values be formatted correctly for the # current database ahead of time. INSERT_COMPLEX_CATEGORY_RDBO: { my $i = 1; sub insert_complex_category_rdbo { my $c = MyTest::RDBO::Complex::Category->new( db => $DB, id => $i + 1_100_000, name => "xCat $i"); $c->save; $i++; } } INSERT_COMPLEX_CATEGORY_CDBI: { my $i = 1; sub insert_complex_category_cdbi { MyTest::CDBI::Complex::Category->create({ id => $i + 2_200_000, name => "xCat $i" }); $i++; } } INSERT_COMPLEX_CATEGORY_CDBS: { my $i = 1; sub insert_complex_category_cdbs { MyTest::CDBI::Sweet::Complex::Category->create({ id => $i + 4_400_000, name => "xCat $i" }); $i++; } } INSERT_COMPLEX_CATEGORY_DBIC: { my $i = 1; sub insert_complex_category_dbic { #MyTest::DBIC::Schema::Complex::Category->create({ id => $i + 3_300_000, name => "xCat $i" }); $DBIC_Complex_Category_RS->create({ id => $i + 3_300_000, name => "xCat $i" }); $i++; } } INSERT_COMPLEX_PRODUCT_RDBO: { my $i = 1; sub reset_insert_complex_product_rdbo { $i = 1 } sub insert_complex_product_rdbo { my $p = MyTest::RDBO::Complex::Product->new; set_state_loading($p); $p->init(db => $DB, id => $i + 1_100_000, name => "Product $i", category_id => 2, status => 'temp', published => '2005-01-02 12:34:56'); $p->save; $i++; } } INSERT_COMPLEX_PRODUCT_CDBI: { my $i = 1; sub insert_complex_product_cdbi { MyTest::CDBI::Complex::Product->create({ id => $i + 2_200_000, name => "Product $i", category_id => 2, status => 'temp', published => '2005-01-02 12:34:56' }); $i++; } } INSERT_COMPLEX_PRODUCT_CDBS: { my $i = 1; sub insert_complex_product_cdbs { MyTest::CDBI::Sweet::Complex::Product->create({ id => $i + 4_400_000, name => "Product $i", category_id => 2, status => 'temp', published => '2005-01-02 12:34:56' }); $i++; } } INSERT_COMPLEX_PRODUCT_DBIC: { my $i = 1; sub reset_insert_complex_product_dbic { $i = 1 } sub insert_complex_product_dbic { #MyTest::DBIC::Schema::Complex::Product->create({ $DBIC_Complex_Product_RS->create({ id => $i + 3_300_000, name => "Product $i", category_id => 2, status => 'temp', published => '2005-01-02 12:34:56' }); $i++; } } # # Accessor # ACCCESSOR_COMPLEX_CATEGORY_RDBO: { sub accessor_complex_category_rdbo { my $c = MyTest::RDBO::Complex::Category->new( db => $DB, id => 1 + 1_100_000); $c->load; for(1 .. ACCESSOR_ITERATIONS) { for(qw(id name)) { $c->$_(); } } } } ACCCESSOR_COMPLEX_CATEGORY_CDBI: { sub accessor_complex_category_cdbi { my $c = MyTest::CDBI::Complex::Category->retrieve(1 + 200_000); for(1 .. ACCESSOR_ITERATIONS) { for(qw(id name)) { $c->$_(); } } } } ACCCESSOR_COMPLEX_CATEGORY_CDBS: { sub accessor_complex_category_cdbs { my $c = MyTest::CDBI::Sweet::Complex::Category->retrieve(1 + 400_000); for(1 .. ACCESSOR_ITERATIONS) { for(qw(id name)) { $c->$_(); } } } } ACCCESSOR_COMPLEX_CATEGORY_DBIC: { sub accessor_complex_category_dbic { #my $c = MyTest::DBIC::Schema::Complex::Category->find(1 + 300_000); my $c = $DBIC_Complex_Category_RS->single({ id => 1 + 300_000 }); for(1 .. ACCESSOR_ITERATIONS) { for(qw(id name)) { $c->$_(); } } } } ACCCESSOR_COMPLEX_PRODUCT_RDBO: { sub accessor_complex_product_rdbo { my $p = MyTest::RDBO::Complex::Product->new( db => $DB, id => 1 + 1_100_000); $p->load; for(1 .. ACCESSOR_ITERATIONS) { for(qw(id name status fk1 fk2 fk3 published last_modified date_created)) { $p->$_(); } } } } ACCCESSOR_COMPLEX_PRODUCT_CDBI: { sub accessor_complex_product_cdbi { my $p = MyTest::CDBI::Complex::Product->retrieve(1 + 200_000); for(1 .. ACCESSOR_ITERATIONS) { for(qw(id name status fk1 fk2 fk3 published last_modified date_created)) { $p->$_(); } } } } ACCCESSOR_COMPLEX_PRODUCT_CDBS: { sub accessor_complex_product_cdbs { my $p = MyTest::CDBI::Sweet::Complex::Product->retrieve(1 + 400_000); for(1 .. ACCESSOR_ITERATIONS) { for(qw(id name status fk1 fk2 fk3 published last_modified date_created)) { $p->$_(); } } } } ACCCESSOR_COMPLEX_PRODUCT_DBIC: { sub accessor_complex_product_dbic { #my $p = MyTest::DBIC::Schema::Complex::Product->find(1 + 300_000); my $p = $DBIC_Complex_Product_RS->single({ id => 1 + 300_000 }); for(1 .. ACCESSOR_ITERATIONS) { for(qw(id name status fk1 fk2 fk3 published last_modified date_created)) { $p->$_(); } } } } # # Load # LOAD_COMPLEX_CATEGORY_RDBO: { my $i = 1; sub load_complex_category_rdbo { my $c = MyTest::RDBO::Complex::Category->new( db => $DB, id => $i + 1_100_000); $c->load; $i++; } } LOAD_COMPLEX_CATEGORY_CDBI: { my $i = 1; sub load_complex_category_cdbi { my $c = MyTest::CDBI::Complex::Category->retrieve($i + 2_200_000); $i++; } } LOAD_COMPLEX_CATEGORY_CDBS: { my $i = 1; sub load_complex_category_cdbs { my $c = MyTest::CDBI::Sweet::Complex::Category->retrieve($i + 4_400_000); $i++; } } LOAD_COMPLEX_CATEGORY_DBIC: { my $i = 1; sub load_complex_category_dbic { #my $c = MyTest::DBIC::Schema::Complex::Category->find($i + 3_300_000); my $c = $DBIC_Complex_Category_RS->single({ id => $i + 3_300_000 }); $i++; } } LOAD_COMPLEX_PRODUCT_RDBO: { my $i = 1; sub load_complex_product_rdbo { my $p = MyTest::RDBO::Complex::Product->new( db => $DB, id => $i + 1_100_000); $p->load; $i++; } } LOAD_COMPLEX_PRODUCT_CDBI: { my $i = 1; sub load_complex_product_cdbi { my $c = MyTest::CDBI::Complex::Product->retrieve($i + 2_200_000); $i++; } } LOAD_COMPLEX_PRODUCT_CDBS: { my $i = 1; sub load_complex_product_cdbs { my $c = MyTest::CDBI::Sweet::Complex::Product->retrieve($i + 4_400_000); $i++; } } LOAD_COMPLEX_PRODUCT_DBIC: { my $i = 1; sub load_complex_product_dbic { #my $c = MyTest::DBIC::Schema::Complex::Product->find($i + 3_300_000); my $c = $DBIC_Complex_Product_RS->single({ id => $i + 3_300_000 }); $i++; } } LOAD_COMPLEX_PRODUCT_AND_CATEGORY_RDBO: { my $i = 1; sub load_complex_product_and_category_rdbo { my $p = MyTest::RDBO::Complex::Product->new( db => $DB, id => $i + 1_100_000); $p->load; #(with => [ 'category' ], inject_results => 1, prepare_cached => 1); my $cat = $p->category; my $n = $cat->name; die unless($n =~ /\S/); $i++; } } LOAD_COMPLEX_PRODUCT_AND_CATEGORY_CDBI: { my $i = 1; sub load_complex_product_and_category_cdbi { my $c = MyTest::CDBI::Complex::Product->retrieve($i + 2_200_000); my $cat = $c->category_id; my $n = $cat->name; die unless($n =~ /\S/); $i++; } } LOAD_COMPLEX_PRODUCT_AND_CATEGORY_CDBS: { my $i = 1; sub load_complex_product_and_category_cdbs { my $c = MyTest::CDBI::Sweet::Complex::Product->retrieve($i + 4_400_000); my $cat = $c->category_id; my $n = $cat->name; die unless($n =~ /\S/); $i++; } } LOAD_COMPLEX_PRODUCT_AND_CATEGORY_DBIC: { my $i = 1; sub load_complex_product_and_category_dbic { #my $c = MyTest::DBIC::Schema::Complex::Product->find($i + 3_300_000); my $c = $DBIC_Complex_Product_RS->single({ id => $i + 3_300_000 }); my $cat = $c->category_id; my $n = $cat->name; die unless($n =~ /\S/); $i++; } } # # Update # UPDATE_COMPLEX_CATEGORY_RDBO: { my $i = 1; sub update_complex_category_rdbo { my $c = MyTest::RDBO::Complex::Category->new( db => $DB, id => $i + 1_100_000); $c->load; $c->name($c->name . ' updated'); $c->save; $i++; } } UPDATE_COMPLEX_CATEGORY_CDBI: { my $i = 1; sub update_complex_category_cdbi { my $c = MyTest::CDBI::Complex::Category->retrieve($i + 2_200_000); $c->name($c->name . ' updated'); $c->update; $i++; } } UPDATE_COMPLEX_CATEGORY_CDBS: { my $i = 1; sub update_complex_category_cdbs { my $c = MyTest::CDBI::Sweet::Complex::Category->retrieve($i + 4_400_000); $c->name($c->name . ' updated'); $c->update; $i++; } } UPDATE_COMPLEX_CATEGORY_DBIC: { my $i = 1; sub update_complex_category_dbic { #my $c = MyTest::DBIC::Schema::Complex::Category->find($i + 3_300_000); my $c = $DBIC_Complex_Category_RS->single({ id => $i + 3_300_000 }); $c->name($c->name . ' updated'); $c->update; $i++; } } UPDATE_COMPLEX_PRODUCT_RDBO: { my $i = 1; sub update_complex_product_rdbo { my $p = MyTest::RDBO::Complex::Product->new( db => $DB, id => $i + 1_100_000); $p->load; $p->name($p->name . ' updated'); set_state_loading($p); $p->published('2004-01-02 12:34:55'); unset_state_loading($p); $p->save; $i++; } } UPDATE_COMPLEX_PRODUCT_CDBI: { my $i = 1; sub update_complex_product_cdbi { my $p = MyTest::CDBI::Complex::Product->retrieve($i + 2_200_000); $p->name($p->name . ' updated'); $p->published('2004-01-02 12:34:55'); $p->update; $i++; } } UPDATE_COMPLEX_PRODUCT_CDBS: { my $i = 1; sub update_complex_product_cdbs { my $p = MyTest::CDBI::Sweet::Complex::Product->retrieve($i + 4_400_000); $p->name($p->name . ' updated'); $p->published('2004-01-02 12:34:55'); $p->update; $i++; } } UPDATE_COMPLEX_PRODUCT_DBIC: { my $i = 1; sub update_complex_product_dbic { #my $p = MyTest::DBIC::Schema::Complex::Product->find($i + 3_300_000); my $p = $DBIC_Complex_Product_RS->single({ id => $i + 3_300_000 }); $p->name($p->name . ' updated'); $p->published('2004-01-02 12:34:55'); $p->update; $i++; } } # # Search # SEARCH_COMPLEX_CATEGORY_RDBO: { my $printed = 0; sub search_complex_category_rdbo { my $c = MyTest::RDBO::Complex::Category::Manager->get_categories( db => $DB, query_is_sql => 1, prepare_cached => 1, query => [ name => { like => 'xCat %2%' }, id => { le => 1_100_000 + $Iterations }, id => { ge => 1_100_000 }, ], limit => LIMIT); die unless(@$c); if($Debug && !$printed) { print "search_complex_category_rdbo GOT ", scalar(@$c), "\n"; $printed++; } } } SEARCH_COMPLEX_CATEGORY_CDBI: { my $printed = 0; sub search_complex_category_cdbi { my @c = MyTest::CDBI::Complex::Category->search_where( { name => { -like => 'xCat %2%' }, id => { '<=' => 2_200_000 + $Iterations, '>=' => 2_200_000 }, }, { limit_dialect => $Limit_Dialect, limit => LIMIT }); die unless(@c); if($Debug && !$printed) { print "search_complex_category_cdbi GOT ", scalar(@c), "\n"; $printed++; } } } SEARCH_COMPLEX_CATEGORY_CDBS: { my $printed = 0; sub search_complex_category_cdbs { my @c = MyTest::CDBI::Sweet::Complex::Category->search_where( { name => { -like => 'xCat %2%' }, id => { '<=' => 4_400_000 + $Iterations, '>=' => 4_400_000 } }, { limit_dialect => $Limit_Dialect, limit => LIMIT }); die unless(@c); if($Debug && !$printed) { print "search_complex_category_cdbs GOT ", scalar(@c), "\n"; $printed++; } } } SEARCH_COMPLEX_CATEGORY_DBIC: { my $printed = 0; sub search_complex_category_dbic { my @c = #MyTest::DBIC::Schema::Complex::Category->search( $DBIC_Complex_Category_RS->search( { name => { -like => 'xCat %2%' }, id => { '<=' => 3_300_000 + $Iterations, '>=' => 3_300_000 } }, { rows => LIMIT}); die unless(@c); if($Debug && !$printed) { print "search_complex_category_dbic GOT ", scalar(@c), "\n"; $printed++; } } } SEARCH_COMPLEX_PRODUCT_DBI: { my $printed = 0; sub search_complex_product_dbi { my $sth = $DBH->prepare(<<"EOF"); SELECT id, name, category_id, status, fk1, fk2, fk3, published, last_modified, date_created FROM rose_db_object_test_products WHERE name LIKE 'Product %2%' AND id <= @{[ 500_000 + $Iterations ]} AND id >= 500000 LIMIT @{[ LIMIT ]} EOF $sth->execute; my $p = $sth->fetchall_arrayref; die unless(@$p); if($Debug && !$printed) { print "search_complex_product_dbi GOT ", scalar(@$p), "\n"; $printed++; } } } SEARCH_COMPLEX_PRODUCT_RDBO: { my $printed = 0; sub search_complex_product_rdbo { my $p = MyTest::RDBO::Complex::Product::Manager->get_products( db => $DB, query_is_sql => 1, prepare_cached => 1, inject_results => 1, query => [ id => { le => 100_000 + $Iterations }, id => { ge => 100_000 }, name => { like => 'Product %2%' }, ], limit => LIMIT); die unless(@$p); if($Debug && !$printed) { print "search_complex_product_rdbo GOT ", scalar(@$p), "\n"; $printed++; } } } SEARCH_COMPLEX_PRODUCT_CDBI: { my $printed = 0; sub search_complex_product_cdbi { my @p = MyTest::CDBI::Complex::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 200_000 + $Iterations, '>=' => 200_000 } }, { limit_dialect => $Limit_Dialect, limit => LIMIT }); die unless(@p); if($Debug && !$printed) { print "search_complex_product_cdbi GOT ", scalar(@p), "\n"; $printed++; } } } SEARCH_COMPLEX_PRODUCT_CDBS: { my $printed = 0; sub search_complex_product_cdbs { my @p = MyTest::CDBI::Sweet::Complex::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 400_000 + $Iterations, '>=' => 400_000 } }, { limit_dialect => $Limit_Dialect, limit => LIMIT }); die unless(@p); if($Debug && !$printed) { print "search_complex_product_cdbs GOT ", scalar(@p), "\n"; $printed++; } } } SEARCH_COMPLEX_PRODUCT_DBIC: { my $printed = 0; sub search_complex_product_dbic { my @p = #MyTest::DBIC::Schema::Complex::Product->search( $DBIC_Complex_Product_RS->search( { name => { -like => 'Product %2%' }, id => { '<=' => 300_000 + $Iterations, '>=' => 300_000 } }, { rows => LIMIT}); die unless(@p); if($Debug && !$printed) { print "search_complex_product_dbic GOT ", scalar(@p), "\n"; $printed++; } } } SEARCH_COMPLEX_PRODUCT_AND_CATEGORY_RDBO: { my $printed = 0; sub search_complex_product_and_category_rdbo { my $ps = MyTest::RDBO::Complex::Product::Manager->get_products( db => $DB, query_is_sql => 1, prepare_cached => 1, inject_results => 1, query => [ id => { le => 100_000 + $Iterations }, id => { ge => 100_000 }, name => { like => 'Product %2%' }, ], with_objects => [ 'category' ], limit => LIMIT); die unless(@$ps); if($Debug && !$printed) { print "search_complex_product_and_category_rdbo GOT ", scalar(@$ps), "\n"; $printed++; } foreach my $p (@$ps) { my $cat = $p->category; my $n = $cat->name; die unless($n =~ /\S/); } } } SEARCH_COMPLEX_PRODUCT_AND_CATEGORY_CDBI: { my $printed = 0; sub search_complex_product_and_category_cdbi { my @p = MyTest::CDBI::Complex::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 200_000 + $Iterations, '>=' => 200_000 } }, { limit_dialect => $Limit_Dialect, limit => LIMIT }); die unless(@p); if($Debug && !$printed) { print "search_complex_product_and_category_cdbi GOT ", scalar(@p), "\n"; $printed++; } foreach my $p (@p) { my $cat = $p->category_id; my $n = $cat->name; die unless($n =~ /\S/); } } } SEARCH_COMPLEX_PRODUCT_AND_CATEGORY_CDBS: { my $printed = 0; sub search_complex_product_and_category_cdbs { my @p = MyTest::CDBI::Sweet::Complex::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 400_000 + $Iterations, '>=' => 400_000 } }, { prefetch => [ 'category_id' ], limit_dialect => $Limit_Dialect, limit => LIMIT }); die unless(@p); if($Debug && !$printed) { print "search_complex_product_and_category_cdbs GOT ", scalar(@p), "\n"; $printed++; } foreach my $p (@p) { my $cat = $p->category_id; my $n = $cat->name; die unless($n =~ /\S/); } } } SEARCH_COMPLEX_PRODUCT_AND_CATEGORY_DBIC: { my $printed = 0; sub search_complex_product_and_category_dbic { my @p = #MyTest::DBIC::Schema::Complex::Product->search( $DBIC_Complex_Product_RS->search( { 'me.name' => { -like => 'Product %2%' }, 'me.id' => { '<=' => 300_000 + $Iterations, '>=' => 300_000 } }, { prefetch => [ 'category_id' ], rows => LIMIT}); die unless(@p); if($Debug && !$printed) { print "search_complex_product_and_category_dbic GOT ", scalar(@p), "\n"; $printed++; } foreach my $p (@p) { my $cat = $p->category_id; my $n = $cat->name; die unless($n =~ /\S/); } } } # # Search with 1-to-1 and 1-to-n sub-objects # SEARCH_COMPLEX_PRODUCT_AND_CATEGORY_AND_CODE_NAMES_DBI: { my $printed = 0; sub search_complex_product_and_category_and_code_name_dbi { my $sth = $DBH->prepare(<<"EOF"); SELECT p.id, p.name, p.category_id, p.status, p.fk1, p.fk2, p.fk3, p.published, p.last_modified, p.date_created, c.id, c.name, n.id, n.product_id, n.name FROM rose_db_object_test_products p LEFT OUTER JOIN rose_db_object_test_code_names n ON(n.product_id = p.id), rose_db_object_test_categories c WHERE c.id = p.category_id AND n.product_id = p.id AND p.name LIKE 'Product %2%' AND p.id <= @{[ 500_000 + $Iterations ]} AND p.id >= 500000 EOF # LIMIT @{[ MAX_LIMIT ]} $sth->execute; my %row; $sth->bind_columns(\@row{qw(id name category_id status fk1 fk2 fk3 published last_modified date_created cat_id cat_name cn_id cn_product_id cn_name)}); my @ps; while($sth->fetch) { push(@ps, { %row }); } die unless(@ps); if($Debug && !$printed) { my(%seen, $num); foreach my $p (@ps) { $num++ unless($seen{$p->{'id'}}++); } print "search_complex_product_and_category_and_code_name_dbi GOT $num\n"; $printed++; } foreach my $p (@ps) { my $n = $p->{'cat_name'}; die unless($n =~ /\S/); my $cn = $p->{'cn_name'}; die unless(index($cn, 'CN ') == 0); } } } SEARCH_COMPLEX_PRODUCT_AND_CATEGORY_AND_CODE_NAMES_RDBO: { my $printed = 0; sub search_complex_product_and_category_and_code_name_rdbo { #local $Rose::DB::Object::Manager::Debug = 1; my $ps = MyTest::RDBO::Complex::Product::Manager->get_products( db => $DB, query_is_sql => 1, prepare_cached => 1, inject_results => 1, query => [ id => { le => 100_000 + $Iterations }, id => { ge => 100_000 }, name => { like => 'Product %2%' }, ], with_objects => [ 'code_names' ], require_objects => [ 'category' ], #limit => MAX_LIMIT ); die unless(@$ps); if($Debug && !$printed) { print "search_complex_product_and_category_and_code_name_rdbo GOT ", scalar(@$ps), "\n"; $printed++; } foreach my $p (@$ps) { my $cat = $p->category; my $n = $cat->name; die unless($n =~ /\S/); foreach my $cn ($p->code_names) { die unless(index($cn->name, 'CN ') == 0); } } } } SEARCH_COMPLEX_PRODUCT_AND_CATEGORY_AND_CODE_NAMES_CDBI: { my $printed = 0; sub search_complex_product_and_category_and_code_name_cdbi { my @p = MyTest::CDBI::Complex::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 200_000 + $Iterations, '>=' => 200_000 } }, #{ limit_dialect => $Limit_Dialect, limit => MAX_LIMIT } ); die unless(@p); if($Debug && !$printed) { print "search_complex_product_and_category_and_code_name_cdbi GOT ", scalar(@p), "\n"; $printed++; } foreach my $p (@p) { my $cat = $p->category_id; my $n = $cat->name; die unless($n =~ /\S/); foreach my $cn ($p->code_names) { die unless(index($cn->name, 'CN ') == 0); } } } } SEARCH_COMPLEX_PRODUCT_AND_CATEGORY_AND_CODE_NAMES_CDBS: { my $printed = 0; sub search_complex_product_and_category_and_code_name_cdbs { my @p = MyTest::CDBI::Sweet::Complex::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 400_000 + $Iterations, '>=' => 400_000 } }, { prefetch => [ 'category_id' ], #limit_dialect => $Limit_Dialect, limit => MAX_LIMIT }); die unless(@p); if($Debug && !$printed) { print "search_complex_product_and_category_and_code_name_cdbs GOT ", scalar(@p), "\n"; $printed++; } foreach my $p (@p) { my $cat = $p->category_id; my $n = $cat->name; die unless($n =~ /\S/); foreach my $cn ($p->code_names) { die unless(index($cn->name, 'CN ') == 0); } } } } SEARCH_COMPLEX_PRODUCT_AND_CATEGORY_AND_CODE_NAMES_DBIC: { my $printed = 0; sub search_complex_product_and_category_and_code_name_dbic { my @p = #MyTest::DBIC::Schema::Complex::Product->search( $DBIC_Complex_Product_RS->search( { 'me.name' => { -like => 'Product %2%' }, 'me.id' => { '<=' => 300_000 + $Iterations, '>=' => 300_000 } }, { prefetch => [ 'category_id', 'code_names' ], #software_limit => 1, #rows => MAX_LIMIT, }); die unless(@p); if($Debug && !$printed) { print "search_complex_product_and_category_and_code_name_dbic GOT ", scalar(@p), "\n"; $printed++; } foreach my $p (@p) { my $cat = $p->category_id; my $n = $cat->name; die unless($n =~ /\S/); my $rs = $p->code_names; foreach my $cn ($rs->all) { die unless(index($cn->name, 'CN ') == 0); } } } } # # Search with limit and offset # SEARCH_LIMIT_OFFSET_COMPLEX_PRODUCT_RDBO: { my $printed = 0; sub search_limit_offset_complex_product_rdbo { my $p = MyTest::RDBO::Complex::Product::Manager->get_products( db => $DB, query_is_sql => 1, prepare_cached => 1, inject_results => 1, query => [ id => { le => 100_000 + $Iterations }, id => { ge => 100_000 }, name => { like => 'Product %2%' }, ], limit => LIMIT, offset => OFFSET); die unless(@$p); if($Debug && !$printed) { print "search_limit_offset_complex_product_rdbo GOT ", scalar(@$p), "\n"; $printed++; } } } SEARCH_LIMIT_OFFSET_COMPLEX_PRODUCT_CDBI: { my $printed = 0; sub search_limit_offset_complex_product_cdbi { die "Unsupported"; my @p = MyTest::CDBI::Complex::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 200_000 + $Iterations, '>=' => 200_000 } }, { limit_dialect => $Limit_Dialect, limit => LIMIT, offset => OFFSET }); die unless(@p); if($Debug && !$printed) { print "search_limit_offset_complex_product_cdbi GOT ", scalar(@p), "\n"; $printed++; } } } SEARCH_LIMIT_OFFSET_COMPLEX_PRODUCT_CDBS: { my $printed = 0; sub search_limit_offset_complex_product_cdbs { my @p = MyTest::CDBI::Sweet::Complex::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 400_000 + $Iterations, '>=' => 400_000 } }, { limit_dialect => $Limit_Dialect, limit => LIMIT, offset => OFFSET }); die unless(@p); if($Debug && !$printed) { print "search_limit_offset_complex_product_cdbs GOT ", scalar(@p), "\n"; $printed++; } } } SEARCH_LIMIT_OFFSET_COMPLEX_PRODUCT_DBIC: { my $printed = 0; sub search_limit_offset_complex_product_dbic { my @p = #MyTest::DBIC::Schema::Complex::Product->search( $DBIC_Complex_Product_RS->search( { 'me.name' => { -like => 'Product %2%' }, 'me.id' => { '<=' => 300_000 + $Iterations, '>=' => 300_000 } }, { rows => LIMIT, offset => OFFSET }); die unless(@p); if($Debug && !$printed) { print "search_limit_offset_complex_product_dbic GOT ", scalar(@p), "\n"; $printed++; } } } # # Iterate # ITERATE_COMPLEX_CATEGORY_RDBO: { my $printed = 0; sub iterate_complex_category_rdbo { my $iter = MyTest::RDBO::Complex::Category::Manager->get_categories_iterator( db => $DB, query_is_sql => 1, prepare_cached => 1, inject_results => 1, query => [ id => { le => 100_000 + $Iterations }, id => { ge => 100_000 }, name => { like => 'xCat %2%' }, ], limit => LIMIT); my $i = 0; while(my $c = $iter->next) { $i++; } if($Debug && !$printed) { print "iterate_complex_category_rdbo GOT $i\n"; $printed++; } } } ITERATE_COMPLEX_CATEGORY_CDBI: { my $printed = 0; sub iterate_complex_category_cdbi { my $iter = MyTest::CDBI::Complex::Category->search_where( { name => { -like => 'xCat %2%' }, id => { '<=' => 200_000 + $Iterations, '>=' => 200_000 }, }, { limit_dialect => $Limit_Dialect, limit => LIMIT }); my $i = 0; while(my $c = $iter->next) { $i++; } if($Debug && !$printed) { print "iterate_complex_category_cdbi GOT $i\n"; $printed++; } } } ITERATE_COMPLEX_CATEGORY_CDBS: { my $printed = 0; sub iterate_complex_category_cdbs { my $iter = MyTest::CDBI::Sweet::Complex::Category->search_where( { name => { -like => 'xCat %2%' }, id => { '<=' => 400_000 + $Iterations, '>=' => 400_000 } }, { limit_dialect => $Limit_Dialect, limit => LIMIT }); my $i = 0; while(my $c = $iter->next) { $i++; } if($Debug && !$printed) { print "iterate_complex_category_cdbs GOT $i\n"; $printed++; } } } ITERATE_COMPLEX_CATEGORY_DBIC: { my $printed = 0; sub iterate_complex_category_dbic { my $iter = #MyTest::DBIC::Schema::Complex::Category->search( $DBIC_Complex_Category_RS->search( { name => { -like => 'xCat %2%' }, id => { '<=' => 300_000 + $Iterations, '>=' => 300_000 } }, { rows => LIMIT}); my $i = 0; while(my $c = $iter->next) { $i++; } if($Debug && !$printed) { print "iterate_complex_category_dbic GOT $i\n"; $printed++; } } } ITERATE_COMPLEX_PRODUCT_RDBO: { my $printed = 0; sub iterate_complex_product_rdbo { my $iter = MyTest::RDBO::Complex::Product::Manager->get_products_iterator( db => $DB, query_is_sql => 1, prepare_cached => 1, query => [ id => { le => 100_000 + $Iterations }, id => { ge => 100_000 }, name => { like => 'Product %2%' }, ], limit => LIMIT); my $i = 0; while(my $p = $iter->next) { $i++; } if($Debug && !$printed) { print "iterate_complex_product_rdbo GOT $i\n"; $printed++; } } } ITERATE_COMPLEX_PRODUCT_CDBI: { my $printed = 0; sub iterate_complex_product_cdbi { my $iter = MyTest::CDBI::Complex::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 200_000 + $Iterations, '>=' => 200_000 } }, { limit_dialect => $Limit_Dialect, limit => LIMIT }); my $i = 0; while(my $p = $iter->next) { $i++; } if($Debug && !$printed) { print "iterate_complex_product_cdbi GOT $i\n"; $printed++; } } } ITERATE_COMPLEX_PRODUCT_CDBS: { my $printed = 0; sub iterate_complex_product_cdbs { my $iter = MyTest::CDBI::Sweet::Complex::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 400_000 + $Iterations, '>=' => 400_000 } }, { limit_dialect => $Limit_Dialect, limit => LIMIT }); my $i = 0; while(my $p = $iter->next) { $i++; } if($Debug && !$printed) { print "iterate_complex_product_cdbs GOT $i\n"; $printed++; } } } ITERATE_COMPLEX_PRODUCT_DBIC: { my $printed = 0; sub iterate_complex_product_dbic { my $iter = #MyTest::DBIC::Schema::Complex::Product->search( $DBIC_Complex_Product_RS->search( { name => { -like => 'Product %2%' }, id => { '<=' => 300_000 + $Iterations, '>=' => 300_000 } }, { rows => LIMIT}); my $i = 0; while(my $p = $iter->next) { $i++; } if($Debug && !$printed) { print "iterate_complex_product_dbic GOT $i\n"; $printed++; } } } ITERATE_COMPLEX_PRODUCT_AND_CATEGORY_RDBO: { my $printed = 0; sub iterate_complex_product_and_category_rdbo { my $iter = MyTest::RDBO::Complex::Product::Manager->get_products_iterator( db => $DB, query_is_sql => 1, prepare_cached => 1, query => [ id => { le => 100_000 + $Iterations }, id => { ge => 100_000 }, name => { like => 'Product %2%' }, ], with_objects => [ 'category' ], limit => LIMIT); my $i = 0; while(my $p = $iter->next) { $i++; my $cat = $p->category; my $n = $cat->name; die unless($n =~ /\S/); } if($Debug && !$printed) { print "iterate_complex_product_and_category_rdbo GOT $i\n"; $printed++; } } } ITERATE_COMPLEX_PRODUCT_AND_CATEGORY_CDBI: { my $printed = 0; sub iterate_complex_product_and_category_cdbi { my $iter = MyTest::CDBI::Complex::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 200_000 + $Iterations, '>=' => 200_000 } }, { limit_dialect => $Limit_Dialect, limit => LIMIT }); my $i = 0; while(my $p = $iter->next) { $i++; my $cat = $p->category_id; my $n = $cat->name; die unless($n =~ /\S/); } if($Debug && !$printed) { print "iterate_complex_product_and_category_cdbi GOT $i\n"; $printed++; } } } ITERATE_COMPLEX_PRODUCT_AND_CATEGORY_CDBS: { my $printed = 0; sub iterate_complex_product_and_category_cdbs { my $iter = MyTest::CDBI::Sweet::Complex::Product->search_where( { name => { -like => 'Product %2%' }, id => { '<=' => 400_000 + $Iterations, '>=' => 400_000 } }, { prefetch => [ 'category_id' ], limit_dialect => $Limit_Dialect, limit => LIMIT }); my $i = 0; while(my $p = $iter->next) { $i++; my $cat = $p->category_id; my $n = $cat->name; die unless($n =~ /\S/); } if($Debug && !$printed) { print "iterate_complex_product_and_category_cdbs GOT $i\n"; $printed++; } } } ITERATE_COMPLEX_PRODUCT_AND_CATEGORY_DBIC: { my $printed = 0; sub iterate_complex_product_and_category_dbic { my $iter = #MyTest::DBIC::Schema::Complex::Product->search( $DBIC_Complex_Product_RS->search( { 'me.name' => { -like => 'Product %2%' }, 'me.id' => { '<=' => 300_000 + $Iterations, '>=' => 300_000 } }, { prefetch => [ 'category_id' ], rows => LIMIT }); my $i = 0; while(my $p = $iter->next) { $i++; my $cat = $p->category_id; my $n = $cat->name; die unless($n =~ /\S/); } if($Debug && !$printed) { print "iterate_complex_product_and_category_dbic GOT $i\n"; $printed++; } } } # # Delete # DELETE_COMPLEX_PRODUCT_DBI: { my $i = 1; sub delete_complex_product_dbi { my $sth = $DBH->prepare('DELETE FROM rose_db_object_test_products WHERE id = ?'); $sth->execute($i + 500_000); $i++; } } DELETE_COMPLEX_PRODUCT_RDBO: { my $i = 1; sub delete_complex_product_rdbo { my $p = MyTest::RDBO::Complex::Product->new( db => $DB, id => $i + 1_100_000); $p->delete(prepare_cached => $i > 1); $i++; } } DELETE_COMPLEX_PRODUCT_CDBI: { my $i = 1; sub delete_complex_product_cdbi { my $c = MyTest::CDBI::Complex::Product->retrieve($i + 2_200_000); $c->delete; $i++; } } DELETE_COMPLEX_PRODUCT_CDBS: { my $i = 1; sub delete_complex_product_cdbs { my $c = MyTest::CDBI::Sweet::Complex::Product->retrieve($i + 4_400_000); $c->delete; $i++; } } DELETE_COMPLEX_PRODUCT_DBIC: { my $i = 1; sub delete_complex_product_dbic { #my $c = MyTest::DBIC::Schema::Complex::Product->find($i + 3_300_000); my $c = $DBIC_Complex_Product_RS->single({ id => $i + 3_300_000 }); $c->delete; $i++; } } # # Insert or update # INSERT_OR_UPDATE_SIMPLE_CATEGORY_DBI: { my $i = 1; my $supports_on_duplicate_key_update; sub insert_or_update_simple_category_dbi { unless(defined $supports_on_duplicate_key_update) { if(lc $DBH->{'Driver'}{'Name'} eq 'mysql') { my $vers = $DBH->get_info(18); # SQL_DBMS_VER # Convert to an integer, e.g., 5.1.13 -> 5001013 if($vers =~ /^(\d+)\.(\d+)(?:\.(\d+))?/) { $vers = sprintf('%d%03d%03d', $1, $2, $3 || 0); } if($vers >= 4_001_000) { $supports_on_duplicate_key_update = 1; } } else { $supports_on_duplicate_key_update = 0; } } if($supports_on_duplicate_key_update) { my $sth = $DBH->prepare_cached(<<'EOF'); INSERT INTO rose_db_object_test_categories (id, name) VALUES (?, ?) ON DUPLICATE KEY UPDATE id = ?, name = ? EOF $sth->execute($i + 500_000, "xCat $i", $i + 500_000, "xCat $i"); } else { my $sth = $DBH->prepare_cached('SELECT * FROM rose_db_object_test_categories WHERE id = ?'); $sth->execute($i + 500_000); my $found = $sth->fetchrow_arrayref; $sth->finish; if($found) { $sth = $DBH->prepare_cached('UPDATE rose_db_object_test_categories SET name = ? WHERE id = ?'); $sth->execute("xCat $i", $i + 500_000); } else { $sth = $DBH->prepare_cached('INSERT INTO rose_db_object_test_categories (id, name) VALUES (?, ?)'); $sth->execute($i + 500_000, "xCat $i"); } } $i++; } } INSERT_OR_UPDATE_SIMPLE_CATEGORY_RDBO_DKU: { my $i = 1; sub insert_or_update_simple_category_rdbo_dku { my $c = MyTest::RDBO::Simple::Category->new( db => $DB, id => $i + 100_000, name => "xCat $i"); $c->insert_or_update; $i++; } } INSERT_OR_UPDATE_SIMPLE_CATEGORY_RDBO_STD: { my $i = 1; sub insert_or_update_simple_category_rdbo_std { my $c = MyTest::RDBO::Simple::Category->new( db => $DB, id => $i + 100_000, name => "xCat $i"); $c->insert_or_update_std; $i++; } } INSERT_OR_UPDATE_SIMPLE_CATEGORY_CDBI: { my $i = 1; sub insert_or_update_simple_category_cdbi { my $c = MyTest::CDBI::Simple::Category->find_or_create({ id => $i + 200_000, name => "xCat $i" }); $i++; } } INSERT_OR_UPDATE_SIMPLE_CATEGORY_CDBS: { my $i = 1; sub insert_or_update_simple_category_cdbs { my $c = MyTest::CDBI::Sweet::Simple::Category->find_or_create({ id => $i + 400_000, name => "xCat $i" }); $i++; } } INSERT_OR_UPDATE_SIMPLE_CATEGORY_DBIC: { my $i = 1; sub insert_or_update_simple_category_dbic { my $c = $DBIC_Simple_Category_RS->update_or_create({ id => $i + 300_000, name => "xCat $i" }); $i++; } } INSERT_OR_UPDATE_COMPLEX_CODE_NAME_RDBO_DKU: { my $i = 1; sub insert_or_update_complex_code_name_rdbo_dku { my $c = MyTest::RDBO::Complex::CodeName->new( db => $DB, product_id => $i + 1_100_000, name => "CN 1.1x1 $i"); $c->insert_or_update; $i++; } } INSERT_OR_UPDATE_COMPLEX_CODE_NAME_RDBO_STD: { my $i = 1; sub insert_or_update_complex_code_name_rdbo_std { my $c = MyTest::RDBO::Complex::CodeName->new( db => $DB, product_id => $i + 1_100_000, name => "CN 1.1x1 $i"); $c->insert_or_update_std; $i++; } } INSERT_OR_UPDATE_COMPLEX_CODE_NAME_DBIC: { my $i = 1; sub insert_or_update_complex_code_name_dbic { $DBIC_Complex_CodeName_RS->update_or_create({ product_id => $i + 3_300_000, name => "CN 3.3x1 $i" }); $i++; } } } sub Bench { my($name, $iterations, $tests, $no_newline) = @_; my %filtered_tests; my $db_regex = ($No_RDBO ? '\b(?:' : '\b(?:RDBO.*|') . join('|', map { $Cmp_Abbreviation{$_} } @Cmp_To) . ')\b'; $db_regex = qr($db_regex); if(($name =~ /^Simple:/ && !($Opt{'simple'} || $Opt{'simple-and-complex'})) || ($name =~ /^Complex:/ && !($Opt{'complex'} || $Opt{'simple-and-complex'}))) { return 0; } while(my($test_name, $code) = each(%$tests)) { next unless($test_name =~ /$db_regex/); $filtered_tests{$test_name} = $code; } return 0 unless(%filtered_tests && (!$Bench_Match || $name =~ /$Bench_Match/)); my($save_stdout, $silent); no strict 'refs'; if($name =~ s/^SILENT:\s*//) { open($save_stdout, '>&', select()) or warn "Could not dup STDOUT - $!"; open(select(), '>/dev/null') or warn "Could not redirect STDOUT to /dev/null - $!"; $silent = 1; } print "\n" unless($no_newline); print "# $name\n"; if($Opt{'time'} || $Opt{'time-and-compare'}) { my $r = timethese($iterations, \%filtered_tests); cmpthese($r) if($Opt{'time-and-compare'}); } else { cmpthese($iterations, \%filtered_tests); } if($silent) { open(select(), '>&', $save_stdout) or warn "Could not restore STDOUT - $!"; } return 1; } sub Run_Tests { $Params::Validate::NO_VALIDATION = 1; # # Insert # Bench('Simple: insert 1', $Iterations, { 'DBI ' => \&insert_simple_category_dbi, 'RDBO' => \&insert_simple_category_rdbo, 'CDBI' => \&insert_simple_category_cdbi, 'CDBS' => \&insert_simple_category_cdbs, 'DBIC' => \&insert_simple_category_dbic, }, 'no-newline'); Bench('Complex: insert 1', $Iterations, { 'DBI ' => \&insert_simple_category_dbi, 'RDBO' => \&insert_complex_category_rdbo, 'CDBI' => \&insert_complex_category_cdbi, 'CDBS' => \&insert_complex_category_cdbs, 'DBIC' => \&insert_complex_category_dbic, }, $Opt{'complex'} ? 'no-newline' : 0); Bench('Simple: insert 2', $Iterations, { 'DBI ' => \&insert_simple_product_dbi, 'RDBO' => \&insert_simple_product_rdbo, 'CDBI' => \&insert_simple_product_cdbi, 'CDBS' => \&insert_simple_product_cdbs, 'DBIC' => \&insert_simple_product_dbic, }); Bench('Complex: insert 2', $Iterations, { 'DBI ' => \&insert_simple_product_dbi, 'RDBO' => \&insert_complex_product_rdbo, 'CDBI' => \&insert_complex_product_cdbi, 'CDBS' => \&insert_complex_product_cdbs, 'DBIC' => \&insert_complex_product_dbic, }); INTERNAL_LOOPERS1: { # # Accessor # # It's okay for these tests to only have a few iterations because they # loop internally. local $Benchmark::Min_Count = 1; Bench('Simple: accessor 1', $CPU_Time, { 'DBI ' => \&accessor_simple_category_dbi, 'RDBO' => \&accessor_simple_category_rdbo, 'CDBI' => \&accessor_simple_category_cdbi, 'CDBS' => \&accessor_simple_category_cdbs, 'DBIC' => \&accessor_simple_category_dbic, }); Bench('Complex: accessor 1', $CPU_Time, { 'DBI ' => \&accessor_simple_category_dbi, 'RDBO' => \&accessor_complex_category_rdbo, 'CDBI' => \&accessor_complex_category_cdbi, 'CDBS' => \&accessor_complex_category_cdbs, 'DBIC' => \&accessor_complex_category_dbic, }); Bench('Simple: accessor 2', $CPU_Time, { 'DBI ' => \&accessor_simple_product_dbi, 'RDBO' => \&accessor_simple_product_rdbo, 'CDBI' => \&accessor_simple_product_cdbi, 'CDBS' => \&accessor_simple_product_cdbs, 'DBIC' => \&accessor_simple_product_dbic, }); Bench('Complex: accessor 2', $CPU_Time, { 'DBI ' => \&accessor_simple_product_dbi, 'RDBO' => \&accessor_complex_product_rdbo, 'CDBI' => \&accessor_complex_product_cdbi, 'CDBS' => \&accessor_complex_product_cdbs, 'DBIC' => \&accessor_complex_product_dbic, }); } # # Load # Bench('Simple: load 1', $Iterations, { 'DBI ' => \&load_simple_category_dbi, 'RDBO' => \&load_simple_category_rdbo, 'CDBI' => \&load_simple_category_cdbi, 'CDBS' => \&load_simple_category_cdbs, 'DBIC' => \&load_simple_category_dbic, }); #Bench('Complex: load 1', $Iterations, #{ # 'RDBO' => \&load_complex_category_rdbo, # 'CDBI' => \&load_complex_category_cdbi, # 'CDBS' => \&load_complex_category_cdbs, # 'DBIC' => \&load_complex_category_dbic, #}); Bench('Simple: load 2', $Iterations, { 'DBI ' => \&load_simple_product_dbi, 'RDBO' => \&load_simple_product_rdbo, 'CDBI' => \&load_simple_product_cdbi, 'CDBS' => \&load_simple_product_cdbs, 'DBIC' => \&load_simple_product_dbic, }); Bench('Complex: load 2', $Iterations, { 'DBI ' => \&load_simple_product_dbi, 'RDBO' => \&load_complex_product_rdbo, 'CDBI' => \&load_complex_product_cdbi, 'CDBS' => \&load_complex_product_cdbs, 'DBIC' => \&load_complex_product_dbic, }); Bench('Simple: load 3', $Iterations, { 'DBI ' => \&load_simple_product_and_category_dbi, 'RDBO' => \&load_simple_product_and_category_rdbo, 'CDBI' => \&load_simple_product_and_category_cdbi, 'CDBS' => \&load_simple_product_and_category_cdbs, 'DBIC' => \&load_simple_product_and_category_dbic, }); Bench('Complex: load 3', $Iterations, { 'DBI ' => \&load_simple_product_and_category_dbi, 'RDBO' => \&load_complex_product_and_category_rdbo, 'CDBI' => \&load_complex_product_and_category_cdbi, 'CDBS' => \&load_complex_product_and_category_cdbs, 'DBIC' => \&load_complex_product_and_category_dbic, }); # # Update # Bench('Simple: update 1', $Iterations, { 'DBI ' => \&update_simple_category_dbi, 'RDBO' => \&update_simple_category_rdbo, 'CDBI' => \&update_simple_category_cdbi, 'CDBS' => \&update_simple_category_cdbs, 'DBIC' => \&update_simple_category_dbic, }); #Bench('Complex: update 1', $Iterations, #{ # 'RDBO' => \&update_complex_category_rdbo, # 'CDBI' => \&update_complex_category_cdbi, # 'CDBS' => \&update_complex_category_cdbs, # 'DBIC' => \&update_complex_category_dbic, #}); Bench('Simple: update 2', $Iterations, { 'DBI ' => \&update_simple_product_dbi, 'RDBO' => \&update_simple_product_rdbo, 'CDBI' => \&update_simple_product_cdbi, 'CDBS' => \&update_simple_product_cdbs, 'DBIC' => \&update_simple_product_dbic, }); Bench('Complex: update 2', $Iterations, { 'DBI ' => \&update_simple_product_dbi, 'RDBO' => \&update_complex_product_rdbo, 'CDBI' => \&update_complex_product_cdbi, 'CDBS' => \&update_complex_product_cdbs, 'DBIC' => \&update_complex_product_dbic, }); INTERNAL_LOOPERS2: { # # Search # # It's okay for these tests to only have a few iterations because they # loop internally. local $Benchmark::Min_Count = 1; Bench('Simple: search 1', $CPU_Time, { 'DBI ' => \&search_simple_category_dbi, 'RDBO' => \&search_simple_category_rdbo, 'CDBI' => \&search_simple_category_cdbi, 'CDBS' => \&search_simple_category_cdbs, 'DBIC' => \&search_simple_category_dbic, }); #Bench('Complex: search 1', $CPU_Time, #{ # 'DBI ' => \&search_simple_category_dbi, # 'RDBO' => \&search_complex_category_rdbo, # 'CDBI' => \&search_complex_category_cdbi, # 'CDBS' => \&search_complex_category_cdbs, # 'DBIC' => \&search_complex_category_dbic, #}); Bench('Simple: search 2', $CPU_Time, { 'DBI ' => \&search_simple_product_dbi, 'RDBO' => \&search_simple_product_rdbo, 'CDBI' => \&search_simple_product_cdbi, 'CDBS' => \&search_simple_product_cdbs, 'DBIC' => \&search_simple_product_dbic, }); Bench('Complex: search 2', $CPU_Time, { 'DBI ' => \&search_simple_product_dbi, 'RDBO' => \&search_complex_product_rdbo, 'CDBI' => \&search_complex_product_cdbi, 'CDBS' => \&search_complex_product_cdbs, 'DBIC' => \&search_complex_product_dbic, }); Bench('Simple: search with limit and offset', $CPU_Time, { 'DBI ' => \&search_limit_offset_simple_product_dbi, 'RDBO' => \&search_limit_offset_simple_product_rdbo, #'CDBI' => \&search_limit_offset_simple_product_cdbi, 'CDBS' => \&search_limit_offset_simple_product_cdbs, 'DBIC' => \&search_limit_offset_simple_product_dbic, }); Bench('Complex: search with limit and offset', $CPU_Time, { 'DBI ' => \&search_limit_offset_simple_product_dbi, 'RDBO' => \&search_limit_offset_complex_product_rdbo, #'CDBI' => \&search_limit_offset_complex_product_cdbi, 'CDBS' => \&search_limit_offset_complex_product_cdbs, 'DBIC' => \&search_limit_offset_complex_product_dbic, }); Make_Indexes(); Bench('Simple: search with 1-to-1 sub-objects', $CPU_Time, { 'DBI ' => \&search_simple_product_and_category_dbi, 'RDBO' => \&search_simple_product_and_category_rdbo, 'CDBI' => \&search_simple_product_and_category_cdbi, 'CDBS' => \&search_simple_product_and_category_cdbs, 'DBIC' => \&search_simple_product_and_category_dbic, }); Bench('Complex: search with 1-to-1 sub-objects', $CPU_Time , { 'DBI ' => \&search_simple_product_and_category_dbi, 'RDBO' => \&search_complex_product_and_category_rdbo, 'CDBI' => \&search_complex_product_and_category_cdbi, 'CDBS' => \&search_complex_product_and_category_cdbs, 'DBIC' => \&search_complex_product_and_category_dbic, }); Insert_Code_Names(); # no reason to bench this CPU_MISERS: { local $Benchmark::Min_Count = 0; local $Benchmark::Min_CPU = 0; # These tests take forever (wallclock), even when set to 1 CPU # second. Force a reasonable number of iterations, scaled # coarsely based on how many iterations other tests are using. # # Update: whaddaya know, now they seem to work...nevermind. #my $Tiny_Interations = $Iterations <= 1000 ? 5 : # $Iterations <= 3000 ? 2 : # $Iterations <= 5000 ? 1 : # 1; Bench('Simple: search with 1-to-1 and 1-to-n sub-objects', $CPU_Time, #$Tiny_Interations, { 'DBI ' => \&search_simple_product_and_category_and_code_name_dbi, 'RDBO' => \&search_simple_product_and_category_and_code_name_rdbo, 'CDBI' => \&search_simple_product_and_category_and_code_name_cdbi, 'CDBS' => \&search_simple_product_and_category_and_code_name_cdbs, 'DBIC' => \&search_simple_product_and_category_and_code_name_dbic, }); Bench('Complex: search with 1-to-1 and 1-to-n sub-objects', $CPU_Time, #$Tiny_Interations, { 'DBI ' => \&search_complex_product_and_category_and_code_name_dbi, 'RDBO' => \&search_complex_product_and_category_and_code_name_rdbo, 'CDBI' => \&search_complex_product_and_category_and_code_name_cdbi, 'CDBS' => \&search_complex_product_and_category_and_code_name_cdbs, 'DBIC' => \&search_complex_product_and_category_and_code_name_dbic, }); } # # Iterate # Bench('Simple: iterate 1', $CPU_Time, { 'DBI ' => \&iterate_simple_category_dbi, 'RDBO' => \&iterate_simple_category_rdbo, 'CDBI' => \&iterate_simple_category_cdbi, 'CDBS' => \&iterate_simple_category_cdbs, 'DBIC' => \&iterate_simple_category_dbic, }); Bench('Complex: iterate 1', $CPU_Time, { 'DBI ' => \&iterate_simple_category_dbi, 'RDBO' => \&iterate_complex_category_rdbo, 'CDBI' => \&iterate_complex_category_cdbi, 'CDBS' => \&iterate_complex_category_cdbs, 'DBIC' => \&iterate_complex_category_dbic, }); Bench('Simple: iterate 2', $CPU_Time, { 'DBI ' => \&iterate_simple_product_dbi, 'RDBO' => \&iterate_simple_product_rdbo, 'CDBI' => \&iterate_simple_product_cdbi, 'CDBS' => \&iterate_simple_product_cdbs, 'DBIC' => \&iterate_simple_product_dbic, }); Bench('Complex: iterate 2', $CPU_Time, { 'DBI ' => \&iterate_simple_product_dbi, 'RDBO' => \&iterate_complex_product_rdbo, 'CDBI' => \&iterate_complex_product_cdbi, 'CDBS' => \&iterate_complex_product_cdbs, 'DBIC' => \&iterate_complex_product_dbic, }); Bench('Simple: iterate 3', $CPU_Time, { 'DBI ' => \&iterate_simple_product_and_category_dbi, 'RDBO' => \&iterate_simple_product_and_category_rdbo, 'CDBI' => \&iterate_simple_product_and_category_cdbi, 'CDBS' => \&iterate_simple_product_and_category_cdbs, 'DBIC' => \&iterate_simple_product_and_category_dbic, }); Bench('Complex: iterate 3', $CPU_Time, { 'DBI ' => \&iterate_simple_product_and_category_dbi, 'RDBO' => \&iterate_complex_product_and_category_rdbo, 'CDBI' => \&iterate_complex_product_and_category_cdbi, 'CDBS' => \&iterate_complex_product_and_category_cdbs, 'DBIC' => \&iterate_complex_product_and_category_dbic, }); } # # Delete # Drop_Indexes(); Bench('Simple: delete', $Iterations, { 'DBI ' => \&delete_simple_category_dbi, 'RDBO' => \&delete_simple_category_rdbo, 'CDBI' => \&delete_simple_category_cdbi, 'CDBS' => \&delete_simple_category_cdbs, 'DBIC' => \&delete_simple_category_dbic, }); my $did_complex_delete = Bench('Complex: delete', $Iterations, { 'DBI ' => \&delete_complex_product_dbi, 'RDBO' => \&delete_complex_product_rdbo, 'CDBI' => \&delete_complex_product_cdbi, 'CDBS' => \&delete_complex_product_cdbs, 'DBIC' => \&delete_complex_product_dbic, }); Bench('Simple: insert or update', $Iterations, { 'DBI ' => \&insert_or_update_simple_category_dbi, 'RDBO' => \&insert_or_update_simple_category_rdbo_dku, #'RDBO (dku)' => \&insert_or_update_simple_category_rdbo_dku, #'RDBO (std)' => \&insert_or_update_simple_category_rdbo_std, 'CDBI' => \&insert_or_update_simple_category_cdbi, 'CDBS' => \&insert_or_update_simple_category_cdbs, 'DBIC' => \&insert_or_update_simple_category_dbic, }); if($did_complex_delete) { # Must re-insert to provide referential integrity targets for the next test reset_insert_complex_product_dbic(); reset_insert_complex_product_rdbo(); Bench('SILENT: Complex: insert 2', $Iterations, { 'RDBO' => \&insert_complex_product_rdbo, 'DBIC' => \&insert_complex_product_dbic, }); } Bench('Complex: insert or update', $Iterations, { 'RDBO' => \&insert_or_update_complex_code_name_rdbo_dku, #'RDBO (dku)' => \&insert_or_update_complex_code_name_rdbo_dku, #'RDBO (std)' => \&insert_or_update_complex_code_name_rdbo_std, 'DBIC' => \&insert_or_update_complex_code_name_dbic, }); $DB && $DB->disconnect; } sub Check_DB { my $dbh; # PostgreSQL eval { $dbh = Rose::DB->new('pg')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have_DB{'pg'} = 1; } # MySQL eval { $dbh = Rose::DB->new('mysql')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have_DB{'mysql'} = 1; } # SQLite eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have_DB{'sqlite'} = 1; } # Informix eval { $dbh = Rose::DB->new('informix')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $Have_DB{'informix'} = 1; } @Use_DBs = sort keys %Have_DB; } sub Init_DB { my %init = map { $_ => 1 } @Use_DBs; my $dbh; foreach my $to_init (@Use_DBs) { unless($Have_DB{$to_init}) { die "*** ERROR: Cannot connect to database: $to_init\n"; } } # # PostgreSQL # if($init{'pg'}) { $dbh = Rose::DB->new('pg')->retain_dbh() or die Rose::DB->error; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test_code_names'); $dbh->do('DROP TABLE rose_db_object_test_products'); $dbh->do('DROP TABLE rose_db_object_test_categories'); $dbh->do('DROP TABLE rose_db_object_test_codes'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_codes ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, code VARCHAR(32), PRIMARY KEY(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_categories ( id SERIAL PRIMARY KEY, name VARCHAR(255) NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_products ( id SERIAL PRIMARY KEY, name VARCHAR(255) NOT NULL, category_id INT REFERENCES rose_db_object_test_categories (id), status VARCHAR(32) DEFAULT 'active', fk1 INT, fk2 INT, fk3 INT, published TIMESTAMP, last_modified TIMESTAMP DEFAULT NOW(), date_created TIMESTAMP DEFAULT NOW(), FOREIGN KEY (fk1, fk2, fk3) REFERENCES rose_db_object_test_codes (k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_code_names ( id SERIAL PRIMARY KEY, product_id INT NOT NULL REFERENCES rose_db_object_test_products (id), name VARCHAR(32), UNIQUE(name) ) EOF foreach my $i (1 .. 10) { $dbh->do(<<"EOF"); INSERT INTO rose_db_object_test_codes (k1, k2, k3, code) VALUES ($i, @{[$i + 1]}, @{[$i + 2]}, 'MYCODE$i') EOF } foreach my $i (1 .. 10) { $dbh->do(<<"EOF"); INSERT INTO rose_db_object_test_categories (name) VALUES ('Cat $i') EOF } foreach my $i (1 .. 10) { $dbh->do(<<"EOF"); INSERT INTO rose_db_object_test_products ( name, category_id, status, fk1, fk2, fk3 ) VALUES ( 'Product $i', $i, '@{[ rand > .25 ? 'active' : 'disabled' ]}', $i, @{[$i + 1]}, @{[$i + 2]} ) EOF } $dbh->disconnect; $Inited_DB{'pg'} = 1; } # # MySQL # if($init{'mysql'}) { $dbh = Rose::DB->new('mysql')->retain_dbh() or die Rose::DB->error; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test_code_names'); $dbh->do('DROP TABLE rose_db_object_test_products'); $dbh->do('DROP TABLE rose_db_object_test_categories'); $dbh->do('DROP TABLE rose_db_object_test_codes'); } my $innodb = $Opt{'innodb'} ? 'ENGINE=InnoDB' : ''; $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_codes ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, code VARCHAR(32), PRIMARY KEY(k1, k2, k3) ) $innodb EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_categories ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL ) $innodb EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_products ( id INT AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, category_id INT REFERENCES rose_db_object_test_categories (id), status VARCHAR(32) DEFAULT 'active', fk1 INT, fk2 INT, fk3 INT, published DATETIME, last_modified DATETIME, date_created DATETIME ) $innodb EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_code_names ( id INT AUTO_INCREMENT PRIMARY KEY, product_id INT NOT NULL REFERENCES rose_db_object_test_products (id), name VARCHAR(32), UNIQUE(name) ) $innodb EOF foreach my $i (1 .. 10) { $dbh->do(<<"EOF"); INSERT INTO rose_db_object_test_codes (k1, k2, k3, code) VALUES ($i, @{[$i + 1]}, @{[$i + 2]}, 'MYCODE$i') EOF } foreach my $i (1 .. 10) { $dbh->do(<<"EOF"); INSERT INTO rose_db_object_test_categories (name) VALUES ('Cat $i') EOF } foreach my $i (1 .. 10) { $dbh->do(<<"EOF"); INSERT INTO rose_db_object_test_products ( name, category_id, status, fk1, fk2, fk3 ) VALUES ( 'Product $i', $i, '@{[ rand > .25 ? 'active' : 'disabled' ]}', $i, @{[$i + 1]}, @{[$i + 2]} ) EOF } $Inited_DB{'mysql'} = 1; } # # SQLite # if($init{'sqlite'}) { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test_code_names'); $dbh->do('DROP TABLE rose_db_object_test_products'); $dbh->do('DROP TABLE rose_db_object_test_categories'); $dbh->do('DROP TABLE rose_db_object_test_codes'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_codes ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, code VARCHAR(32), PRIMARY KEY(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_categories ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_products ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, category_id INT REFERENCES rose_db_object_test_categories (id), status VARCHAR(32) DEFAULT 'active', fk1 INT, fk2 INT, fk3 INT, published DATETIME, last_modified DATETIME, date_created DATETIME ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_code_names ( id INTEGER PRIMARY KEY AUTOINCREMENT, product_id INT NOT NULL REFERENCES rose_db_object_test_products (id), name VARCHAR(32), UNIQUE(name) ) EOF foreach my $i (1 .. 10) { $dbh->do(<<"EOF"); INSERT INTO rose_db_object_test_codes (k1, k2, k3, code) VALUES ($i, @{[$i + 1]}, @{[$i + 2]}, 'MYCODE$i') EOF } foreach my $i (1 .. 10) { $dbh->do(<<"EOF"); INSERT INTO rose_db_object_test_categories (name) VALUES ('Cat $i') EOF } foreach my $i (1 .. 10) { $dbh->do(<<"EOF"); INSERT INTO rose_db_object_test_products ( name, category_id, status, fk1, fk2, fk3 ) VALUES ( 'Product $i', $i, '@{[ rand > .25 ? 'active' : 'disabled' ]}', $i, @{[$i + 1]}, @{[$i + 2]} ) EOF } $Inited_DB{'sqlite'} = 1; } # # Informix # if($init{'informix'}) { $dbh = Rose::DB->new('informix')->retain_dbh() or die Rose::DB->error; # Drop existing table and create schema, ignoring errors { local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; $dbh->do('DROP TABLE rose_db_object_test_code_names'); $dbh->do('DROP TABLE rose_db_object_test_products'); $dbh->do('DROP TABLE rose_db_object_test_categories'); $dbh->do('DROP TABLE rose_db_object_test_codes'); } $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_codes ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, code VARCHAR(32), PRIMARY KEY(k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_categories ( id SERIAL PRIMARY KEY, name VARCHAR(255) NOT NULL ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_products ( id SERIAL PRIMARY KEY, name VARCHAR(255) NOT NULL, category_id INT REFERENCES rose_db_object_test_categories (id), status VARCHAR(32) DEFAULT 'active', fk1 INT, fk2 INT, fk3 INT, published DATETIME YEAR TO SECOND, last_modified DATETIME YEAR TO SECOND, date_created DATETIME YEAR TO SECOND, FOREIGN KEY (fk1, fk2, fk3) REFERENCES rose_db_object_test_codes (k1, k2, k3) ) EOF $dbh->do(<<"EOF"); CREATE TABLE rose_db_object_test_code_names ( id SERIAL PRIMARY KEY, product_id INT NOT NULL REFERENCES rose_db_object_test_products (id), name VARCHAR(32), UNIQUE(name) ) EOF foreach my $i (1 .. 10) { $dbh->do(<<"EOF"); INSERT INTO rose_db_object_test_codes (k1, k2, k3, code) VALUES ($i, @{[$i + 1]}, @{[$i + 2]}, 'MYCODE$i') EOF } foreach my $i (1 .. 10) { $dbh->do(<<"EOF"); INSERT INTO rose_db_object_test_categories (name) VALUES ('Cat $i') EOF } foreach my $i (1 .. 10) { $dbh->do(<<"EOF"); INSERT INTO rose_db_object_test_products ( name, category_id, status, fk1, fk2, fk3 ) VALUES ( 'Product $i', $i, '@{[ rand > .25 ? 'active' : 'disabled' ]}', $i, @{[$i + 1]}, @{[$i + 2]} ) EOF } $Inited_DB{'informix'} = 1; } } END { $DB && $DB->disconnect; if($MyTest::CDBI::Base::DB) { $MyTest::CDBI::Base::DB = undef; MyTest::CDBI::Base->db_Main->disconnect; } if($MyTest::CDBI::Sweet::Base::DB) { $MyTest::CDBI::Sweet::Base::DB = undef; MyTest::CDBI::Sweet::Base->db_Main->disconnect; } # Delete test tables if($Inited_DB{'pg'}) { my $dbh = Rose::DB->new('pg')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test_code_names'); $dbh->do('DROP TABLE rose_db_object_test_products'); $dbh->do('DROP TABLE rose_db_object_test_categories'); $dbh->do('DROP TABLE rose_db_object_test_codes'); $dbh->disconnect; } if($Inited_DB{'mysql'}) { my $dbh = Rose::DB->new('mysql')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test_code_names'); $dbh->do('DROP TABLE rose_db_object_test_products'); $dbh->do('DROP TABLE rose_db_object_test_categories'); $dbh->do('DROP TABLE rose_db_object_test_codes'); $dbh->disconnect; } if($Inited_DB{'sqlite'}) { my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test_code_names'); $dbh->do('DROP TABLE rose_db_object_test_products'); $dbh->do('DROP TABLE rose_db_object_test_categories'); $dbh->do('DROP TABLE rose_db_object_test_codes'); $dbh->disconnect; } if($Inited_DB{'informix'}) { my $dbh = Rose::DB->new('informix')->retain_dbh() or die Rose::DB->error; $dbh->do('DROP TABLE rose_db_object_test_code_names'); $dbh->do('DROP TABLE rose_db_object_test_products'); $dbh->do('DROP TABLE rose_db_object_test_categories'); $dbh->do('DROP TABLE rose_db_object_test_codes'); $dbh->disconnect; } } Rose-DB-Object-0.810/t/benchmarks/lib/000750 000765 000120 00000000000 12266514754 017341 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/000750 000765 000120 00000000000 12266514754 020566 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/000750 000765 000120 00000000000 12266514755 021270 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/DBIC/000750 000765 000120 00000000000 12266514755 021270 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/RDBO/000750 000765 000120 00000000000 12266514754 021314 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/RDBO/Complex/000750 000765 000120 00000000000 12266514755 022724 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/RDBO/Simple/000750 000765 000120 00000000000 12266514755 022546 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/RDBO/Simple/Category/000750 000765 000120 00000000000 12266514755 024323 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/RDBO/Simple/Category.pm000755 000765 000120 00000000665 11113677033 024665 0ustar00johnadmin000000 000000 package MyTest::RDBO::Simple::Category; use strict; use Rose::DB::Object; our @ISA = qw(Rose::DB::Object); use Rose::DB::Object::Helpers { insert_or_update => 'insert_or_update_std', insert_or_update_on_duplicate_key => 'insert_or_update', }; __PACKAGE__->meta->table('rose_db_object_test_categories'); __PACKAGE__->meta->columns(qw(id name)); __PACKAGE__->meta->primary_key_columns([ 'id' ]); __PACKAGE__->meta->initialize; 1; Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/RDBO/Simple/Code.pm000755 000765 000120 00000000460 11113677033 023753 0ustar00johnadmin000000 000000 package MyTest::RDBO::Simple::Code; use strict; use Rose::DB::Object; our @ISA = qw(Rose::DB::Object); __PACKAGE__->meta->table('rose_db_object_test_codes'); __PACKAGE__->meta->columns(qw(code k1 k2 k3)); __PACKAGE__->meta->primary_key_columns([ 'k1', 'k2', 'k3' ]); __PACKAGE__->meta->initialize; 1;Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/RDBO/Simple/CodeName.pm000755 000765 000120 00000000704 11113677033 024555 0ustar00johnadmin000000 000000 package MyTest::RDBO::Simple::CodeName; use strict; use Rose::DB::Object; our @ISA = qw(Rose::DB::Object); __PACKAGE__->meta->table('rose_db_object_test_code_names'); __PACKAGE__->meta->columns(qw(id product_id name)); __PACKAGE__->meta->primary_key_columns('id'); __PACKAGE__->meta->foreign_keys ( product => { class => 'MyTest::RDBO::Simple::Product', key_columns => { product_id => 'id' }, }, ); __PACKAGE__->meta->initialize; 1;Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/RDBO/Simple/Product/000750 000765 000120 00000000000 12266514755 024166 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/RDBO/Simple/Product.pm000755 000765 000120 00000001654 11113677033 024527 0ustar00johnadmin000000 000000 package MyTest::RDBO::Simple::Product; use strict; use MyTest::RDBO::Simple::Code; use MyTest::RDBO::Simple::Category; use Rose::DB::Object; our @ISA = qw(Rose::DB::Object); __PACKAGE__->meta->table('rose_db_object_test_products'); __PACKAGE__->meta->columns ( qw(category_id date_created fk1 fk2 fk3 id last_modified name published status) ); __PACKAGE__->meta->primary_key_columns([ 'id' ]); __PACKAGE__->meta->foreign_keys ( category => { class => 'MyTest::RDBO::Simple::Category', key_columns => { category_id => 'id', }, }, code => { class => 'MyTest::RDBO::Simple::Code', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, ); __PACKAGE__->meta->relationships ( code_names => { type => 'one to many', class => 'MyTest::RDBO::Simple::CodeName', column_map => { id => 'product_id' }, } ); __PACKAGE__->meta->initialize; 1;Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/RDBO/Simple/Product/Manager.pm000755 000765 000120 00000000444 11113677033 026075 0ustar00johnadmin000000 000000 package MyTest::RDBO::Simple::Product::Manager; use strict; use MyTest::RDBO::Simple::Product; use Rose::DB::Object::Manager; our @ISA = qw(Rose::DB::Object::Manager); __PACKAGE__->make_manager_methods( base_name => 'products', object_class => 'MyTest::RDBO::Simple::Product'); 1;Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/RDBO/Simple/Category/Manager.pm000755 000765 000120 00000000451 11113677033 026230 0ustar00johnadmin000000 000000 package MyTest::RDBO::Simple::Category::Manager; use strict; use MyTest::RDBO::Simple::Category; use Rose::DB::Object::Manager; our @ISA = qw(Rose::DB::Object::Manager); __PACKAGE__->make_manager_methods( base_name => 'categories', object_class => 'MyTest::RDBO::Simple::Category'); 1;Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/RDBO/Complex/Category/000750 000765 000120 00000000000 12266514755 024501 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/RDBO/Complex/Category.pm000755 000765 000120 00000000323 11113677033 025032 0ustar00johnadmin000000 000000 package MyTest::RDBO::Complex::Category; use strict; use Rose::DB::Object; our @ISA = qw(Rose::DB::Object); __PACKAGE__->meta->table('rose_db_object_test_categories'); __PACKAGE__->meta->auto_initialize; 1; Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/RDBO/Complex/Code.pm000755 000765 000120 00000000312 11113677033 024125 0ustar00johnadmin000000 000000 package MyTest::RDBO::Complex::Code; use strict; use Rose::DB::Object; our @ISA = qw(Rose::DB::Object); __PACKAGE__->meta->table('rose_db_object_test_codes'); __PACKAGE__->meta->auto_initialize; 1;Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/RDBO/Complex/CodeName.pm000755 000765 000120 00000001173 11113677033 024734 0ustar00johnadmin000000 000000 package MyTest::RDBO::Complex::CodeName; use strict; use Rose::DB::Object; our @ISA = qw(Rose::DB::Object); use Rose::DB::Object::Helpers { insert_or_update => 'insert_or_update_std', insert_or_update_on_duplicate_key => 'insert_or_update', }; __PACKAGE__->meta->table('rose_db_object_test_code_names'); __PACKAGE__->meta->columns(qw(id product_id name)); __PACKAGE__->meta->primary_key_columns('id'); __PACKAGE__->meta->unique_key('name'); __PACKAGE__->meta->foreign_keys ( product => { class => 'MyTest::RDBO::Complex::Product', key_columns => { product_id => 'id' }, }, ); __PACKAGE__->meta->initialize; 1;Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/RDBO/Complex/Product/000750 000765 000120 00000000000 12266514754 024343 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/RDBO/Complex/Product.pm000755 000765 000120 00000002336 11113677033 024703 0ustar00johnadmin000000 000000 package MyTest::RDBO::Complex::Product; use strict; use MyTest::RDBO::Complex::Code; use MyTest::RDBO::Complex::Category; use Rose::DB::Object; our @ISA = qw(Rose::DB::Object); __PACKAGE__->meta->table('rose_db_object_test_products'); __PACKAGE__->meta->columns ( id => { type => 'serial', primary_key => 1 }, name => { type => 'varchar' }, category_id => { type => 'integer' }, status => { type => 'varchar' }, fk1 => { type => 'integer' }, fk2 => { type => 'integer' }, fk3 => { type => 'integer' }, published => { type => 'datetime' }, last_modified => { type => 'datetime' }, date_created => { type => 'datetime' }, ); __PACKAGE__->meta->foreign_keys ( category => { class => 'MyTest::RDBO::Complex::Category', key_columns => { category_id => 'id', } }, code => { class => 'MyTest::RDBO::Complex::Code', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', } } ); __PACKAGE__->meta->relationships ( code_names => { type => 'one to many', class => 'MyTest::RDBO::Simple::CodeName', column_map => { id => 'product_id' }, } ); __PACKAGE__->meta->initialize; 1;Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/RDBO/Complex/Product/Manager.pm000755 000765 000120 00000000450 11113677033 026250 0ustar00johnadmin000000 000000 package MyTest::RDBO::Complex::Product::Manager; use strict; use MyTest::RDBO::Complex::Product; use Rose::DB::Object::Manager; our @ISA = qw(Rose::DB::Object::Manager); __PACKAGE__->make_manager_methods( base_name => 'products', object_class => 'MyTest::RDBO::Complex::Product'); 1; Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/RDBO/Complex/Category/Manager.pm000755 000765 000120 00000000454 11113677033 026411 0ustar00johnadmin000000 000000 package MyTest::RDBO::Complex::Category::Manager; use strict; use MyTest::RDBO::Complex::Category; use Rose::DB::Object::Manager; our @ISA = qw(Rose::DB::Object::Manager); __PACKAGE__->make_manager_methods( base_name => 'categories', object_class => 'MyTest::RDBO::Complex::Category'); 1;Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/DBIC/Schema/000750 000765 000120 00000000000 12266514755 022470 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/DBIC/Schema.pm000755 000765 000120 00000000414 11113677033 023022 0ustar00johnadmin000000 000000 package MyTest::DBIC::Schema; use strict; use base 'DBIx::Class::Schema'; # Load MyTest::DBIC::Schema::* __PACKAGE__->load_classes(map { ("Simple::$_", "Complex::$_") } qw(Category Code CodeName Product)); our $DB; # set in bench.pl 1; Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/DBIC/Schema/Complex/000750 000765 000120 00000000000 12266514755 024077 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/DBIC/Schema/Simple/000750 000765 000120 00000000000 12266514755 023721 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/DBIC/Schema/Simple/Category.pm000755 000765 000120 00000000406 11113677033 026031 0ustar00johnadmin000000 000000 package MyTest::DBIC::Schema::Simple::Category; use strict; use base 'DBIx::Class'; __PACKAGE__->load_components(qw(Core)); __PACKAGE__->table('rose_db_object_test_categories'); __PACKAGE__->add_columns(qw(id name)); __PACKAGE__->set_primary_key('id'); 1; Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/DBIC/Schema/Simple/Code.pm000755 000765 000120 00000000416 11113677033 025127 0ustar00johnadmin000000 000000 package MyTest::DBIC::Schema::Simple::Code; use strict; use base 'DBIx::Class'; __PACKAGE__->load_components(qw(Core)); __PACKAGE__->table('rose_db_object_test_codes'); __PACKAGE__->add_columns(qw(code k1 k2 k3)); __PACKAGE__->set_primary_key('k1', 'k2', 'k3'); 1; Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/DBIC/Schema/Simple/CodeName.pm000755 000765 000120 00000000740 11113677033 025730 0ustar00johnadmin000000 000000 package MyTest::DBIC::Schema::Simple::CodeName; use strict; use base 'DBIx::Class'; __PACKAGE__->load_components(qw(Core)); __PACKAGE__->table('rose_db_object_test_code_names'); __PACKAGE__->add_columns(qw(id product_id name)); __PACKAGE__->set_primary_key('id'); __PACKAGE__->add_relationship('product_id', 'MyTest::DBIC::Schema::Simple::Product', { 'foreign.id' => 'self.product_id' }, { accessor => 'filter' }); 1; Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/DBIC/Schema/Simple/Product.pm000755 000765 000120 00000001616 11113677033 025700 0ustar00johnadmin000000 000000 package MyTest::DBIC::Schema::Simple::Product; use strict; use base 'DBIx::Class'; __PACKAGE__->load_components(qw(Core)); use MyTest::DBIC::Schema::Simple::Code; use MyTest::DBIC::Schema::Complex::CodeName; use MyTest::DBIC::Schema::Simple::Category; __PACKAGE__->table('rose_db_object_test_products'); __PACKAGE__->add_columns(qw(category_id date_created fk1 fk2 fk3 id last_modified name published status)); __PACKAGE__->set_primary_key('id'); __PACKAGE__->add_relationship('category_id', 'MyTest::DBIC::Schema::Simple::Category', { 'foreign.id' => 'self.category_id' }, { accessor => 'filter' }); __PACKAGE__->add_relationship('code_names', 'MyTest::DBIC::Schema::Simple::CodeName', { 'foreign.product_id' => 'self.id' }, { accessor => 'multi', join_type => 'LEFT OUTER' }); 1; Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/DBIC/Schema/Complex/Category.pm000755 000765 000120 00000000407 11113677033 026210 0ustar00johnadmin000000 000000 package MyTest::DBIC::Schema::Complex::Category; use strict; use base 'DBIx::Class'; __PACKAGE__->load_components(qw(Core)); __PACKAGE__->table('rose_db_object_test_categories'); __PACKAGE__->add_columns(qw(id name)); __PACKAGE__->set_primary_key('id'); 1; Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/DBIC/Schema/Complex/Code.pm000755 000765 000120 00000000417 11113677033 025306 0ustar00johnadmin000000 000000 package MyTest::DBIC::Schema::Complex::Code; use strict; use base 'DBIx::Class'; __PACKAGE__->load_components(qw(Core)); __PACKAGE__->table('rose_db_object_test_codes'); __PACKAGE__->add_columns(qw(code k1 k2 k3)); __PACKAGE__->set_primary_key('k1', 'k2', 'k3'); 1; Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/DBIC/Schema/Complex/CodeName.pm000755 000765 000120 00000001037 11113677033 026106 0ustar00johnadmin000000 000000 package MyTest::DBIC::Schema::Complex::CodeName; use strict; use base 'DBIx::Class'; __PACKAGE__->load_components(qw(Core)); __PACKAGE__->table('rose_db_object_test_code_names'); __PACKAGE__->add_columns(qw(id product_id name)); __PACKAGE__->set_primary_key('id'); __PACKAGE__->add_unique_constraint(name_key => [ 'name' ]); __PACKAGE__->add_relationship('product_id', 'MyTest::DBIC::Schema::Complex::Product', { 'foreign.id' => 'self.product_id' }, { accessor => 'filter' }); 1; Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/DBIC/Schema/Complex/Product.pm000755 000765 000120 00000005002 11113677033 026047 0ustar00johnadmin000000 000000 package MyTest::DBIC::Schema::Complex::Product; use strict; use base 'DBIx::Class'; __PACKAGE__->load_components(qw(Core)); use MyTest::DBIC::Schema::Complex::Code; use MyTest::DBIC::Schema::Complex::CodeName; use MyTest::DBIC::Schema::Complex::Category; __PACKAGE__->table('rose_db_object_test_products'); __PACKAGE__->add_columns(qw(category_id date_created fk1 fk2 fk3 id last_modified name published status)); __PACKAGE__->set_primary_key('id'); __PACKAGE__->inflate_column(date_created => { inflate => sub { $MyTest::DBIC::Schema::DB->parse_datetime($_[0]) }, deflate => sub { my $arg = shift; if(ref $arg eq 'SCALAR') { $arg = $MyTest::DBIC::Schema::DB->parse_datetime($$arg); } $MyTest::DBIC::Schema::DB->format_datetime($arg) } }); __PACKAGE__->inflate_column(last_modified => { inflate => sub { $MyTest::DBIC::Schema::DB->parse_datetime($_[0]) }, deflate => sub { my $arg = shift; if(ref $arg eq 'SCALAR') { $arg = $MyTest::DBIC::Schema::DB->parse_datetime($$arg); } $MyTest::DBIC::Schema::DB->format_datetime($arg) } }); __PACKAGE__->inflate_column(published => { inflate => sub { $MyTest::DBIC::Schema::DB->parse_datetime($_[0]) }, deflate => sub { my $arg = shift; if(ref $arg eq 'SCALAR') { $arg = $MyTest::DBIC::Schema::DB->parse_datetime($$arg); } $MyTest::DBIC::Schema::DB->format_datetime($arg) } }); __PACKAGE__->add_relationship('category_id', 'MyTest::DBIC::Schema::Complex::Category', { 'foreign.id' => 'self.category_id' }, { accessor => 'filter' }); __PACKAGE__->add_relationship('code_names', 'MyTest::DBIC::Schema::Complex::CodeName', { 'foreign.product_id' => 'self.id' }, { accessor => 'multi' }); 1; Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Base.pm000755 000765 000120 00000001157 11266201365 022501 0ustar00johnadmin000000 000000 package MyTest::CDBI::Base; use strict; use Rose::DB; use base 'Class::DBI'; our $DB; sub refresh { no strict; no warnings 'redefine'; *Ima::DBI::_mk_db_closure = sub { my ( $class, @connection ) = @_; my $dbh; return sub { unless ( $dbh && $dbh->FETCH('Active') && $dbh->ping ) { my $db = Rose::DB->new; $db->connect_option( RootClass => 'DBIx::ContextualFetch' ); $dbh = $db->retain_dbh; } return $dbh; }; }; $DB = Rose::DB->new; __PACKAGE__->connection($DB->dsn, $DB->username, $DB->password, scalar $DB->connect_options); } 1; Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Complex/000750 000765 000120 00000000000 12266514755 022677 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Simple/000750 000765 000120 00000000000 12266514755 022521 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Sweet/000750 000765 000120 00000000000 12266514755 022357 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Sweet/Base.pm000755 000765 000120 00000001165 11266201365 023567 0ustar00johnadmin000000 000000 package MyTest::CDBI::Sweet::Base; use strict; use Rose::DB; use base 'Class::DBI::Sweet'; sub refresh { no strict; no warnings 'redefine'; *Ima::DBI::_mk_db_closure = sub { my ( $class, @connection ) = @_; my $dbh; return sub { unless ( $dbh && $dbh->FETCH('Active') && $dbh->ping ) { my $db = Rose::DB->new; $db->connect_option( RootClass => 'DBIx::ContextualFetch' ); $dbh = $db->retain_dbh; } return $dbh; }; }; my $db = Rose::DB->new; __PACKAGE__->connection($db->dsn, $db->username, $db->password, scalar $db->connect_options); } 1; Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Sweet/Complex/000750 000765 000120 00000000000 12266514755 023766 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Sweet/Simple/000750 000765 000120 00000000000 12266514755 023610 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Sweet/Simple/Category.pm000755 000765 000120 00000000426 11113677033 025722 0ustar00johnadmin000000 000000 package MyTest::CDBI::Sweet::Simple::Category; use strict; use Class::DBI::AbstractSearch; use base 'MyTest::CDBI::Sweet::Base'; __PACKAGE__->table('rose_db_object_test_categories'); __PACKAGE__->columns(Primary => 'id'); __PACKAGE__->columns(Essential => qw(id name)); 1; Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Sweet/Simple/Code.pm000755 000765 000120 00000000375 11113677033 025022 0ustar00johnadmin000000 000000 package MyTest::CDBI::Sweet::Simple::Code; use strict; use base 'MyTest::CDBI::Sweet::Base'; __PACKAGE__->table('rose_db_object_test_codes'); __PACKAGE__->columns(Primary => 'k1', 'k2', 'k3'); __PACKAGE__->columns(Essential => qw(code k1 k2 k3)); 1;Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Sweet/Simple/CodeName.pm000755 000765 000120 00000000503 11113677033 025614 0ustar00johnadmin000000 000000 package MyTest::CDBI::Sweet::Simple::CodeName; use strict; use base 'MyTest::CDBI::Sweet::Base'; __PACKAGE__->table('rose_db_object_test_code_names'); __PACKAGE__->columns(Primary => 'id'); __PACKAGE__->columns(Essential => qw(id product_id name)); __PACKAGE__->has_a(product_id => 'MyTest::CDBI::Simple::Product'); 1;Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Sweet/Simple/Product.pm000755 000765 000120 00000001463 11113677033 025567 0ustar00johnadmin000000 000000 package MyTest::CDBI::Sweet::Simple::Product; use strict; use Class::DBI::AbstractSearch; use base 'MyTest::CDBI::Sweet::Base'; use MyTest::CDBI::Sweet::Simple::Code; use MyTest::CDBI::Sweet::Simple::CodeName; use MyTest::CDBI::Sweet::Simple::Category; __PACKAGE__->table('rose_db_object_test_products'); __PACKAGE__->columns(Primary => 'id'); __PACKAGE__->columns(Essential => qw(category_id date_created fk1 fk2 fk3 id last_modified name published status)); __PACKAGE__->has_a(category_id => 'MyTest::CDBI::Sweet::Simple::Category'); __PACKAGE__->has_many(code_names => 'MyTest::CDBI::Sweet::Simple::CodeName', { cascade => 'None' }); # Dunno why I have to do this, but it doesn't work without it... my $meta = __PACKAGE__->meta_info(has_many => 'code_names'); $meta->args->{'foreign_key'} = 'product_id'; 1;Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Sweet/Complex/Category.pm000755 000765 000120 00000000427 11113677033 026101 0ustar00johnadmin000000 000000 package MyTest::CDBI::Sweet::Complex::Category; use strict; use Class::DBI::AbstractSearch; use base 'MyTest::CDBI::Sweet::Base'; __PACKAGE__->table('rose_db_object_test_categories'); __PACKAGE__->columns(Primary => 'id'); __PACKAGE__->columns(Essential => qw(id name)); 1; Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Sweet/Complex/Code.pm000755 000765 000120 00000000376 11113677033 025201 0ustar00johnadmin000000 000000 package MyTest::CDBI::Sweet::Complex::Code; use strict; use base 'MyTest::CDBI::Sweet::Base'; __PACKAGE__->table('rose_db_object_test_codes'); __PACKAGE__->columns(Primary => 'k1', 'k2', 'k3'); __PACKAGE__->columns(Essential => qw(code k1 k2 k3)); 1;Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Sweet/Complex/CodeName.pm000755 000765 000120 00000000505 11113677033 025774 0ustar00johnadmin000000 000000 package MyTest::CDBI::Sweet::Complex::CodeName; use strict; use base 'MyTest::CDBI::Sweet::Base'; __PACKAGE__->table('rose_db_object_test_code_names'); __PACKAGE__->columns(Primary => 'id'); __PACKAGE__->columns(Essential => qw(id product_id name)); __PACKAGE__->has_a(product_id => 'MyTest::CDBI::Complex::Product'); 1;Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Sweet/Complex/Product.pm000755 000765 000120 00000002722 11113677033 025744 0ustar00johnadmin000000 000000 package MyTest::CDBI::Sweet::Complex::Product; use strict; use Class::DBI::AbstractSearch; use base 'MyTest::CDBI::Sweet::Base'; use MyTest::CDBI::Sweet::Complex::Code; use MyTest::CDBI::Sweet::Complex::CodeName; use MyTest::CDBI::Sweet::Complex::Category; __PACKAGE__->table('rose_db_object_test_products'); __PACKAGE__->columns(Primary => 'id'); __PACKAGE__->columns(Essential => qw(category_id date_created fk1 fk2 fk3 id last_modified name published status)); __PACKAGE__->has_a(date_created => 'DateTime', inflate => sub { $MyTest::CDBI::Base::DB->parse_datetime(shift) }, deflate => sub { $MyTest::CDBI::Base::DB->format_datetime(shift) }); __PACKAGE__->has_a(last_modified => 'DateTime', inflate => sub { $MyTest::CDBI::Base::DB->parse_datetime(shift) }, deflate => sub { $MyTest::CDBI::Base::DB->format_datetime(shift) }); __PACKAGE__->has_a(published => 'DateTime', inflate => sub { $MyTest::CDBI::Base::DB->parse_datetime(shift) }, deflate => sub { $MyTest::CDBI::Base::DB->format_datetime(shift) }); __PACKAGE__->has_a(category_id => 'MyTest::CDBI::Sweet::Complex::Category'); __PACKAGE__->has_many(code_names => 'MyTest::CDBI::Sweet::Complex::CodeName', { cascade => 'None' }); # Dunno why I have to do this, but it doesn't work without it... my $meta = __PACKAGE__->meta_info(has_many => 'code_names'); $meta->args->{'foreign_key'} = 'product_id'; 1; Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Simple/Category.pm000755 000765 000120 00000000410 11113677033 024624 0ustar00johnadmin000000 000000 package MyTest::CDBI::Simple::Category; use strict; use Class::DBI::AbstractSearch; use base 'MyTest::CDBI::Base'; __PACKAGE__->table('rose_db_object_test_categories'); __PACKAGE__->columns(Primary => 'id'); __PACKAGE__->columns(Essential => qw(id name)); 1; Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Simple/Code.pm000755 000765 000120 00000000357 11113677033 023733 0ustar00johnadmin000000 000000 package MyTest::CDBI::Simple::Code; use strict; use base 'MyTest::CDBI::Base'; __PACKAGE__->table('rose_db_object_test_codes'); __PACKAGE__->columns(Primary => 'k1', 'k2', 'k3'); __PACKAGE__->columns(Essential => qw(code k1 k2 k3)); 1;Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Simple/CodeName.pm000755 000765 000120 00000000465 11113677033 024534 0ustar00johnadmin000000 000000 package MyTest::CDBI::Simple::CodeName; use strict; use base 'MyTest::CDBI::Base'; __PACKAGE__->table('rose_db_object_test_code_names'); __PACKAGE__->columns(Primary => 'id'); __PACKAGE__->columns(Essential => qw(id product_id name)); __PACKAGE__->has_a(product_id => 'MyTest::CDBI::Simple::Product'); 1;Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Simple/Product.pm000755 000765 000120 00000001126 11142315705 024471 0ustar00johnadmin000000 000000 package MyTest::CDBI::Simple::Product; use strict; use Class::DBI::AbstractSearch; use MyTest::CDBI::Simple::Code; use MyTest::CDBI::Simple::CodeName; use MyTest::CDBI::Simple::Category; use base 'MyTest::CDBI::Base'; __PACKAGE__->table('rose_db_object_test_products'); __PACKAGE__->columns(Primary => 'id'); __PACKAGE__->columns(Essential => qw(category_id date_created fk1 fk2 fk3 id last_modified name published status)); __PACKAGE__->has_a(category_id => 'MyTest::CDBI::Simple::Category'); __PACKAGE__->has_many(code_names => 'MyTest::CDBI::Simple::CodeName', { cascade => 'None' }); 1;Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Complex/Category.pm000755 000765 000120 00000000411 11113677033 025003 0ustar00johnadmin000000 000000 package MyTest::CDBI::Complex::Category; use strict; use Class::DBI::AbstractSearch; use base 'MyTest::CDBI::Base'; __PACKAGE__->table('rose_db_object_test_categories'); __PACKAGE__->columns(Primary => 'id'); __PACKAGE__->columns(Essential => qw(id name)); 1; Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Complex/Code.pm000755 000765 000120 00000000360 11113677033 024103 0ustar00johnadmin000000 000000 package MyTest::CDBI::Complex::Code; use strict; use base 'MyTest::CDBI::Base'; __PACKAGE__->table('rose_db_object_test_codes'); __PACKAGE__->columns(Primary => 'k1', 'k2', 'k3'); __PACKAGE__->columns(Essential => qw(code k1 k2 k3)); 1;Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Complex/CodeName.pm000755 000765 000120 00000000470 11113677033 024706 0ustar00johnadmin000000 000000 package MyTest::CDBI::Complex::CodeName; use strict; use base 'MyTest::CDBI::Base'; __PACKAGE__->table('rose_db_object_test_code_names'); __PACKAGE__->columns(Primary => 'id'); __PACKAGE__->columns(Essential => qw(id product_id name)); __PACKAGE__->has_a(product_id => 'MyTest::CDBI::Complex::Product'); 1; Rose-DB-Object-0.810/t/benchmarks/lib/MyTest/CDBI/Complex/Product.pm000755 000765 000120 00000002364 11113677033 024657 0ustar00johnadmin000000 000000 package MyTest::CDBI::Complex::Product; use strict; use Class::DBI::AbstractSearch; use MyTest::CDBI::Complex::Code; use MyTest::CDBI::Complex::CodeName; use MyTest::CDBI::Complex::Category; use base 'MyTest::CDBI::Base'; __PACKAGE__->table('rose_db_object_test_products'); __PACKAGE__->columns(Primary => 'id'); __PACKAGE__->columns(Essential => qw(category_id date_created fk1 fk2 fk3 id last_modified name published status)); __PACKAGE__->has_a(date_created => 'DateTime', inflate => sub { $MyTest::CDBI::Base::DB->parse_datetime(shift) }, deflate => sub { $MyTest::CDBI::Base::DB->format_datetime(shift) }); __PACKAGE__->has_a(last_modified => 'DateTime', inflate => sub { $MyTest::CDBI::Base::DB->parse_datetime(shift) }, deflate => sub { $MyTest::CDBI::Base::DB->format_datetime(shift) }); __PACKAGE__->has_a(published => 'DateTime', inflate => sub { $MyTest::CDBI::Base::DB->parse_datetime(shift) }, deflate => sub { $MyTest::CDBI::Base::DB->format_datetime(shift) }); __PACKAGE__->has_a(category_id => 'MyTest::CDBI::Complex::Category'); __PACKAGE__->has_many(code_names => 'MyTest::CDBI::Complex::CodeName', { cascade => 'None' }); 1;Rose-DB-Object-0.810/lib/Rose/000750 000765 000120 00000000000 12266514754 015671 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/lib/Rose/DB/000750 000765 000120 00000000000 12266514755 016157 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/lib/Rose/DB/Object/000750 000765 000120 00000000000 12266514755 017365 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/lib/Rose/DB/Object.pm000755 000765 000120 00000240677 12266514276 017751 0ustar00johnadmin000000 000000 package Rose::DB::Object; use strict; use Carp(); use Rose::DB; use Rose::DB::Object::Metadata; use Rose::Object; our @ISA = qw(Rose::Object); use Rose::DB::Object::Manager; use Rose::DB::Object::Constants qw(:all); use Rose::DB::Constants qw(IN_TRANSACTION); use Rose::DB::Object::Exception; use Rose::DB::Object::Util(); our $VERSION = '0.810'; our $Debug = 0; # # Object data # use Rose::Object::MakeMethods::Generic ( 'scalar' => [ 'error', 'not_found' ], 'boolean' => [ #FLAG_DB_IS_PRIVATE, STATE_IN_DB, STATE_LOADING, STATE_SAVING, ], ); # # Class methods # sub meta_class { 'Rose::DB::Object::Metadata' } sub meta { my($self) = shift; if(ref $self) { return $self->{META_ATTR_NAME()} ||= $self->meta_class->for_class(ref $self); } return $Rose::DB::Object::Metadata::Objects{$self} || $self->meta_class->for_class($self); } # # Object methods # sub db { my($self) = shift; if(@_) { #$self->{FLAG_DB_IS_PRIVATE()} = 0; my $new_db = shift; # If potentially migrating across db types, "suck through" the # driver-formatted values using the old db before swapping it # with the new one. if($self->{LOADED_FROM_DRIVER()} && $self->{LOADED_FROM_DRIVER()} ne $new_db->{'driver'}) { foreach my $method ($self->meta->column_accessor_method_names) { # Need to catch return to avoid clever methods that # skip work when called in void context. my $val = $self->$method(); } } $self->{'db'} = $new_db; return $new_db; } return $self->{'db'} ||= $self->_init_db; } sub init_db { Rose::DB->new() } sub _init_db { my($self) = shift; my($db, $error); TRY: { local $@; eval { $db = $self->init_db }; $error = $@; } unless($error) { #$self->{FLAG_DB_IS_PRIVATE()} = 1; return $db; } if(ref $error) { $self->error($error); } else { $self->error("Could not init_db() - $error - " . ($db ? $db->error : '')); } $self->meta->handle_error($self); return undef; } sub dbh { my($self) = shift; my $db = $self->db or return undef; if(my $dbh = $db->dbh(@_)) { return $dbh; } else { $self->error($db->error); $self->meta->handle_error($self); return undef; } } use constant LAZY_LOADED_KEY => Rose::DB::Object::Util::lazy_column_values_loaded_key(); sub load { my($self) = $_[0]; # XXX: Must maintain alias to actual "self" object arg my %args = (self => @_); # faster than @_[1 .. $#_]; my $db = $self->db or return 0; my $dbh = $self->dbh or return 0; my $meta = $self->meta; my $prepare_cached = exists $args{'prepare_cached'} ? $args{'prepare_cached'} : $meta->dbi_prepare_cached; local $self->{STATE_SAVING()} = 1; local $self->{SAVING_FOR_LOAD()} = 1; my(@key_columns, @key_methods, @key_values); my $null_key = 0; my $found_key = 0; if(my $key = delete $args{'use_key'}) { my @uk = grep { $_->name eq $key } $meta->unique_keys; if(@uk == 1) { my $defined = 0; @key_columns = $uk[0]->column_names; @key_methods = map { $meta->column_accessor_method_name($_) } @key_columns; @key_values = map { $defined++ if(defined $_); $_ } map { $self->$_() } @key_methods; unless($defined) { $self->error("Could not load() based on key '$key' - column(s) have undefined values"); $meta->handle_error($self); return undef; } if(@key_values != $defined) { $null_key = 1; } } else { Carp::croak "No unique key named '$key' is defined in ", ref($self) } } else { @key_columns = $meta->primary_key_column_names; @key_methods = $meta->primary_key_column_accessor_names; @key_values = grep { defined } map { $self->$_() } @key_methods; unless(@key_values == @key_columns) { my $alt_columns; # Prefer unique keys where we have defined values for all # key columns, but fall back to the first unique key found # where we have at least one defined value. foreach my $cols ($meta->unique_keys_column_names) { my $defined = 0; @key_columns = @$cols; @key_methods = map { $meta->column_accessor_method_name($_) } @key_columns; @key_values = map { $defined++ if(defined $_); $_ } map { $self->$_() } @key_methods; if($defined == @key_columns) { $found_key = 1; last; } $alt_columns ||= $cols if($defined); } if(!$found_key && $alt_columns) { @key_columns = @$alt_columns; @key_methods = map { $meta->column_accessor_method_name($_) } @key_columns; @key_values = map { $self->$_() } @key_methods; $null_key = 1; $found_key = 1; } unless($found_key) { @key_columns = $meta->primary_key_column_names; my $e = Rose::DB::Object::Exception->new( message => "Cannot load " . ref($self) . " without a primary key (" . join(', ', @key_columns) . ') with ' . (@key_columns > 1 ? 'non-null values in all columns' : 'a non-null value') . ' or another unique key with at least one non-null value.', code => EXCEPTION_CODE_NO_KEY); $self->error($e); $meta->handle_error($self); return 0; } } } my $has_lazy_columns = $args{'nonlazy'} ? 0 : $meta->has_lazy_columns; my $column_names; if($has_lazy_columns) { $column_names = $meta->nonlazy_column_names; $self->{LAZY_LOADED_KEY()} = {}; } else { $column_names = $meta->column_names; } # Coerce for_update boolean alias into lock argument if(delete $args{'for_update'}) { $args{'lock'}{'type'} ||= 'for update'; } # # Handle sub-object load in separate code path # if(my $with = $args{'with'}) { my $mgr_class = $args{'manager_class'} || 'Rose::DB::Object::Manager'; my %query; @query{map { "t1.$_" } @key_columns} = @key_values; my($objects, $error); TRY: { local $@; eval { $objects = $mgr_class->get_objects(object_class => ref $self, db => $db, query => [ %query ], with_objects => $with, multi_many_ok => 1, nonlazy => $args{'nonlazy'}, inject_results => $args{'inject_results'}, lock => $args{'lock'}, (exists $args{'prepare_cached'} ? (prepare_cached => $args{'prepare_cached'}) : ())) or Carp::confess $mgr_class->error; if(@$objects > 1) { die "Found ", @$objects, " objects instead of one"; } }; $error = $@; } if($error) { $self->error(ref $error ? $error : "load(with => ...) - $error"); $meta->handle_error($self); return undef; } if(@$objects > 0) { # Sneaky init by object replacement $self = $_[0] = $objects->[0]; # Init by copying attributes (broken; need to do fks and relationships too) #my $methods = $meta->column_mutator_method_names; #my $object = $objects->[0]; # #local $self->{STATE_LOADING()} = 1; #local $object->{STATE_SAVING()} = 1; # #foreach my $method (@$methods) #{ # $self->$method($object->$method()); #} } else { no warnings; $self->error("No such " . ref($self) . ' where ' . join(', ', @key_columns) . ' = ' . join(', ', @key_values)); $self->{'not_found'} = 1; $self->{STATE_IN_DB()} = 0; my $speculative = exists $args{'speculative'} ? $args{'speculative'} : $meta->default_load_speculative; unless($speculative) { $meta->handle_error($self); } return 0; } $self->{STATE_IN_DB()} = 1; $self->{LOADED_FROM_DRIVER()} = $db->{'driver'}; $self->{MODIFIED_COLUMNS()} = {}; return $self || 1; } # # Handle normal load # my($loaded_ok, $error); $self->{'not_found'} = 0; TRY: { local $@; eval { local $self->{STATE_LOADING()} = 1; local $dbh->{'RaiseError'} = 1; my($sql, $sth); if($null_key) { if($has_lazy_columns) { $sql = $meta->load_sql_with_null_key(\@key_columns, \@key_values, $db); } else { $sql = $meta->load_all_sql_with_null_key(\@key_columns, \@key_values, $db); } } else { if($has_lazy_columns) { $sql = $meta->load_sql(\@key_columns, $db); } else { $sql = $meta->load_all_sql(\@key_columns, $db); } } if(my $lock = $args{'lock'}) { $sql .= ' ' . $db->format_select_lock($self, $lock); } # $meta->prepare_select_options (defunct) $sth = $prepare_cached ? $dbh->prepare_cached($sql, undef, 3) : $dbh->prepare($sql); $Debug && warn "$sql - bind params: ", join(', ', grep { defined } @key_values), "\n"; $sth->execute(grep { defined } @key_values); my %row; $sth->bind_columns(undef, \@row{@$column_names}); $loaded_ok = defined $sth->fetch; # The load() query shouldn't find more than one row anyway, # but DBD::SQLite demands this :-/ # XXX: Recent versions of DBD::SQLite seem to have cured this. # XXX: Safe to remove? $sth->finish; if($loaded_ok) { my $methods = $meta->column_mutator_method_names_hash; # Empty existing object? #%$self = (db => $self->db, meta => $meta, STATE_LOADING() => 1); foreach my $name (@$column_names) { my $method = $methods->{$name}; $self->$method($row{$name}); } # Sneaky init by object replacement #my $object = (ref $self)->new(db => $self->db); # #foreach my $name (@$column_names) #{ # my $method = $methods->{$name}; # $object->$method($row{$name}); #} # #$self = $_[0] = $object; } else { no warnings; $self->error("No such " . ref($self) . ' where ' . join(', ', @key_columns) . ' = ' . join(', ', @key_values)); $self->{'not_found'} = 1; $self->{STATE_IN_DB()} = 0; } }; $error = $@; } if($error) { $self->error(ref $error ? $error : "load() - $error"); $meta->handle_error($self); return undef; } unless($loaded_ok) { my $speculative = exists $args{'speculative'} ? $args{'speculative'} : $meta->default_load_speculative; unless($speculative) { $meta->handle_error($self); } return 0; } $self->{STATE_IN_DB()} = 1; $self->{LOADED_FROM_DRIVER()} = $db->{'driver'}; $self->{MODIFIED_COLUMNS()} = {}; return $self || 1; } sub save { my($self, %args) = @_; my $meta = $self->meta; my $cascade = exists $args{'cascade'} ? $args{'cascade'} : $meta->default_cascade_save; # Keep trigger-encumbered and cascade code in separate code path if($self->{ON_SAVE_ATTR_NAME()} || $cascade) { my $db = $args{'db'} || $self->db || return 0; my $ret = $db->begin_work; $args{'db'} ||= $db; unless($ret) { my $error = $db->error; $self->error(ref $error ? $error : "Could not begin transaction before saving - $error"); $self->meta->handle_error($self); return undef; } my $started_new_tx = ($ret == IN_TRANSACTION) ? 0 : 1; my $error; TRY: { local $@; eval { my %did_set; my %code_args = map { ($_ => $args{$_}) } grep { exists $args{$_} } qw(changes_only prepare_cached cascade); # # Do pre-save stuff # my $todo = $self->{ON_SAVE_ATTR_NAME()}{'pre'}; foreach my $fk_name (keys %{$todo->{'fk'}}) { my $code = $todo->{'fk'}{$fk_name}{'set'} or next; my $object = $code->($self, \%code_args); # Account for objects that evaluate to false to due overloading unless($object || ref $object) { die $self->error; } # Track which rows were set so we can avoid deleting # them later in the "delete on save" code $did_set{'fk'}{$fk_name}{Rose::DB::Object::Util::row_id($object)} = 1; } # # Do the actual save # if(!$args{'insert'} && ($args{'update'} || $self->{STATE_IN_DB()})) { $ret = shift->update(@_); } else { $ret = shift->insert(@_); } # # Do post-save stuff # $todo = $self->{ON_SAVE_ATTR_NAME()}{'post'}; # Foreign keys (and some fk-like relationships) foreach my $fk_name (keys %{$todo->{'fk'}}) { foreach my $item (@{$todo->{'fk'}{$fk_name}{'delete'} || []}) { my $code = $item->{'code'}; my $object = $item->{'object'}; # Don't run the code to delete this object if we just set it above next if($did_set{'fk'}{$fk_name}{Rose::DB::Object::Util::row_id($object)}); $code->($self, \%code_args) or die $self->error; } } if($cascade) { foreach my $fk ($meta->foreign_keys) { # If this object was just set above, just save changes (there # should be none) as a way to continue the cascade local $args{'changes_only'} = 1 if($todo->{'fk'}{$fk->name}{'set'}); my $foreign_object = $fk->object_has_foreign_object($self) || next; if(Rose::DB::Object::Util::has_modified_columns($foreign_object) || Rose::DB::Object::Util::has_modified_children($foreign_object)) { $Debug && warn "$self - save foreign ", $fk->name, " - $foreign_object\n"; $foreign_object->save(%args); } } } # Relationships foreach my $rel_name (keys %{$todo->{'rel'}}) { my $code; # Set value(s) if($code = $todo->{'rel'}{$rel_name}{'set'}) { $code->($self, \%code_args) or die $self->error; } # Delete value(s) if($code = $todo->{'rel'}{$rel_name}{'delete'}) { $code->($self, \%code_args) or die $self->error; } # Add value(s) if($code = $todo->{'rel'}{$rel_name}{'add'}{'code'}) { $code->($self, \%code_args) or die $self->error; } } if($cascade) { foreach my $rel ($meta->relationships) { # If this object was just set above, just save changes (there # should be none) as a way to continue the cascade local $args{'changes_only'} = 1 if($todo->{'rel'}{$rel->name}{'set'}); my $related_objects = $rel->object_has_related_objects($self) || next; foreach my $related_object (@$related_objects) { if(Rose::DB::Object::Util::has_modified_columns($related_object) || Rose::DB::Object::Util::has_modified_children($related_object)) { $Debug && warn "$self - save related ", $rel->name, " - $related_object\n"; $related_object->save(%args); } } } } if($started_new_tx) { $db->commit or die $db->error; } }; $error = $@; } delete $self->{ON_SAVE_ATTR_NAME()}; if($error) { $self->error($error); $db->rollback or warn $db->error if($started_new_tx); $self->meta->handle_error($self); return 0; } $self->{MODIFIED_COLUMNS()} = {}; return $ret; } else { if(!$args{'insert'} && ($args{'update'} || $self->{STATE_IN_DB()})) { return shift->update(@_); } return shift->insert(@_); } } sub update { my($self, %args) = @_; my $db = $self->db or return 0; my $dbh = $self->dbh or return 0; my $meta = $self->meta; my $prepare_cached = exists $args{'prepare_cached'} ? $args{'prepare_cached'} : $meta->dbi_prepare_cached; my $changes_only = exists $args{'changes_only'} ? $args{'changes_only'} : $meta->default_update_changes_only; local $self->{STATE_SAVING()} = 1; my @key_columns = $meta->primary_key_column_names; my @key_methods = $meta->primary_key_column_accessor_names; my @key_values = grep { defined } map { $self->$_() } @key_methods; # Special case for tables where all columns are part of the primary key return $self || 1 if(@key_columns == $meta->num_columns); # See comment below #my $null_key = 0; #my $found_key = 0; unless(@key_values == @key_columns) { $self->error("Cannot update " . ref($self) . " without a primary key (" . join(', ', @key_columns) . ') with ' . (@key_columns > 1 ? 'non-null values in all columns' : 'a non-null value')); $self->meta->handle_error($self); return undef; } #my $ret = $db->begin_work; # #unless($ret) #{ # my $error = $db->error; # $self->error(ref $error ? $error : "Could not begin transaction before updating - $error"); # return undef; #} # #my $started_new_tx = ($ret == Rose::DB::Constants::IN_TRANSACTION) ? 0 : 1; my $error; TRY: { local $@; eval { #local $self->{STATE_SAVING()} = 1; local $dbh->{'RaiseError'} = 1; my $sth; if($meta->allow_inline_column_values) { # This versions of update_sql_with_inlining is not needed (see comments # in Rose/DB/Object/Metadata.pm for more information) #my($sql, $bind) = # $meta->update_sql_with_inlining($self, \@key_columns, \@key_values); my($sql, $bind, $bind_params); if($changes_only) { # No changes to save... return $self || 1 unless(%{$self->{MODIFIED_COLUMNS()} || {}}); ($sql, $bind, $bind_params) = $meta->update_changes_only_sql_with_inlining($self, \@key_columns); unless($sql) # skip key-only updates { $self->{MODIFIED_COLUMNS()} = {}; return $self || 1; } } else { ($sql, $bind, $bind_params) = $meta->update_sql_with_inlining($self, \@key_columns); } if($Debug) { no warnings; warn "$sql - bind params: ", join(', ', @$bind, @key_values), "\n"; } $sth = $dbh->prepare($sql); #, $meta->prepare_update_options); if($bind_params) { my $i = 1; foreach my $value (@$bind) { $sth->bind_param($i, $value, $bind_params->[$i - 1]); $i++; } my $kv_idx = 0; foreach my $column_name (@key_columns) { my $column = $meta->column($column_name); $sth->bind_param($i++, $key_values[$kv_idx++], $column->dbi_bind_param_attrs($db)); } $sth->execute; } else { $sth->execute(@$bind, @key_values); } } else { if($changes_only) { # No changes to save... return $self || 1 unless(%{$self->{MODIFIED_COLUMNS()} || {}}); my($sql, $bind, $columns) = $meta->update_changes_only_sql($self, \@key_columns, $db); unless($sql) # skip key-only updates { $self->{MODIFIED_COLUMNS()} = {}; return $self || 1; } # $meta->prepare_update_options (defunct) my $sth = $prepare_cached ? $dbh->prepare_cached($sql, undef, 3) : $dbh->prepare($sql); if($Debug) { no warnings; warn "$sql - bind params: ", join(', ', @$bind, @key_values), "\n"; } if($meta->dbi_requires_bind_param($db)) { my $i = 1; foreach my $column (@$columns) { my $method = $column->accessor_method_name; $sth->bind_param($i++, $self->$method(), $column->dbi_bind_param_attrs($db)); } my $kv_idx = 0; foreach my $column_name (@key_columns) { my $column = $meta->column($column_name); $sth->bind_param($i++, $key_values[$kv_idx++], $column->dbi_bind_param_attrs($db)); } $sth->execute; } else { $sth->execute(@$bind, @key_values); } } elsif($meta->has_lazy_columns) { my($sql, $bind, $columns) = $meta->update_sql($self, \@key_columns, $db); # $meta->prepare_update_options (defunct) my $sth = $prepare_cached ? $dbh->prepare_cached($sql, undef, 3) : $dbh->prepare($sql); if($Debug) { no warnings; warn "$sql - bind params: ", join(', ', @$bind, @key_values), "\n"; } if($meta->dbi_requires_bind_param($db)) { my $i = 1; foreach my $column (@$columns) { my $method = $column->accessor_method_name; $sth->bind_param($i++, $self->$method(), $column->dbi_bind_param_attrs($db)); } my $kv_idx = 0; foreach my $column_name (@key_columns) { my $column = $meta->column($column_name); $sth->bind_param($i++, $key_values[$kv_idx++], $column->dbi_bind_param_attrs($db)); } $sth->execute; } else { $sth->execute(@$bind, @key_values); } } else { my $sql = $meta->update_all_sql(\@key_columns, $db); # $meta->prepare_update_options (defunct) my $sth = $prepare_cached ? $dbh->prepare_cached($sql, undef, 3) : $dbh->prepare($sql); my %key = map { ($_ => 1) } @key_methods; my $method_names = $meta->column_accessor_method_names; if($Debug) { no warnings; warn "$sql - bind params: ", join(', ', (map { $self->$_() } grep { !$key{$_} } @$method_names), grep { defined } @key_values), "\n"; } if($meta->dbi_requires_bind_param($db)) { my $i = 1; foreach my $column (grep { !$key{$_->name} } $meta->columns_ordered) { my $method = $column->accessor_method_name; $sth->bind_param($i++, $self->$method(), $column->dbi_bind_param_attrs($db)); } foreach my $column_name (@key_columns) { my $column = $meta->column($column_name); my $method = $column->accessor_method_name; $sth->bind_param($i++, $self->$method(), $column->dbi_bind_param_attrs($db)); } $sth->execute; } else { $sth->execute( (map { $self->$_() } grep { !$key{$_} } @$method_names), @key_values); } } } #if($started_new_tx) #{ # $db->commit or die $db->error; #} }; $error = $@; } if($error) { $self->error(ref $error ? $error : "update() - $error"); #$db->rollback or warn $db->error if($started_new_tx); $self->meta->handle_error($self); return 0; } $self->{STATE_IN_DB()} = 1; $self->{MODIFIED_COLUMNS()} = {}; return $self || 1; } sub insert { my($self, %args) = @_; my $db = $self->db or return 0; my $dbh = $self->dbh or return 0; my $meta = $self->meta; my $prepare_cached = exists $args{'prepare_cached'} ? $args{'prepare_cached'} : $meta->dbi_prepare_cached; my $changes_only = exists $args{'changes_only'} ? $args{'changes_only'} : $meta->default_insert_changes_only; local $self->{STATE_SAVING()} = 1; my @pk_methods = $meta->primary_key_column_accessor_names; my @pk_values = grep { defined } map { $self->$_() } @pk_methods; #my $ret = $db->begin_work; # #unless($ret) #{ # my $error = $db->error; # $self->error(ref $error ? $error : "Could not begin transaction before inserting - $error"); # return undef; #} # #my $started_new_tx = ($ret > 0) ? 1 : 0; my $using_pk_placeholders = 0; unless(@pk_values == @pk_methods || $args{'on_duplicate_key_update'}) { my @generated_pk_values = $meta->generate_primary_key_values($db); unless(@generated_pk_values) { @generated_pk_values = $meta->generate_primary_key_placeholders($db); $using_pk_placeholders = 1; } unless(@generated_pk_values == @pk_methods) { my $s = (@pk_values == 1 ? '' : 's'); $self->error("Could not generate primary key$s for column$s " . join(', ', @pk_methods)); $self->meta->handle_error($self); return undef; } my @pk_set_methods = map { $meta->column_mutator_method_name($_) } $meta->primary_key_column_names; my $i = 0; foreach my $name (@pk_set_methods) { my $pk_value = shift @generated_pk_values; next unless(defined $pk_value); $self->$name($pk_value); } } my $error; TRY: { local $@; eval { #local $self->{STATE_SAVING()} = 1; local $dbh->{'RaiseError'} = 1; #my $options = $meta->prepare_insert_options; my $sth; if($meta->allow_inline_column_values) { my($sql, $bind, $bind_params); if($args{'on_duplicate_key_update'}) { ($sql, $bind, $bind_params) = $meta->insert_and_on_duplicate_key_update_with_inlining_sql( $self, $db, $changes_only); } elsif($changes_only) { ($sql, $bind, $bind_params) = $meta->insert_changes_only_sql_with_inlining($self); } else { ($sql, $bind, $bind_params) = $meta->insert_sql_with_inlining($self); } if($Debug) { no warnings; warn "$sql - bind params: ", join(', ', @$bind), "\n"; } $sth = $dbh->prepare($sql); #, $options); if($bind_params) { my $i = 1; foreach my $value (@$bind) { $sth->bind_param($i, $value, $bind_params->[$i - 1]); $i++; } $sth->execute; } else { $sth->execute(@$bind); } } else { my $column_names = $meta->column_names; if($args{'on_duplicate_key_update'} || $changes_only) { my($sql, $bind, $columns); if($args{'on_duplicate_key_update'}) { ($sql, $bind, $columns) = $meta->insert_and_on_duplicate_key_update_sql( $self, $db, $changes_only); } else { ($sql, $bind, $columns) = $meta->insert_changes_only_sql($self, $db); } if($Debug) { no warnings; warn $sql, " - bind params: @$bind\n"; } $sth = $prepare_cached ? $dbh->prepare_cached($sql, undef, 3) : $dbh->prepare($sql); if($meta->dbi_requires_bind_param($db)) { my $i = 1; foreach my $column (@$columns) { my $method = $column->accessor_method_name; $sth->bind_param($i++, $self->$method(), $column->dbi_bind_param_attrs($db)); } $sth->execute; } else { $sth->execute(@$bind); } } else { $sth = $prepare_cached ? $dbh->prepare_cached($meta->insert_sql($db), undef, 3) : $dbh->prepare($meta->insert_sql($db)); if($Debug) { no warnings; warn $meta->insert_sql($db), " - bind params: ", join(', ', (map {$self->$_()} $meta->column_accessor_method_names)), "\n"; } #$sth->execute(map { $self->$_() } $meta->column_accessor_method_names); if($meta->dbi_requires_bind_param($db)) { my $i = 1; foreach my $column ($meta->columns_ordered) { my $method = $column->accessor_method_name; $sth->bind_param($i++, $self->$method(), $column->dbi_bind_param_attrs($db)); } $sth->execute; } else { $sth->execute(map { $self->$_() } $meta->column_accessor_method_names); } } } if(@pk_methods == 1) { my $get_pk = $pk_methods[0]; if($using_pk_placeholders || !defined $self->$get_pk()) { local $self->{STATE_LOADING()} = 1; my $set_pk = $meta->column_mutator_method_name($meta->primary_key_column_names); #$self->$set_pk($db->last_insertid_from_sth($sth, $self)); $self->$set_pk($db->last_insertid_from_sth($sth)); $self->{STATE_IN_DB()} = 1; } elsif(!$using_pk_placeholders && defined $self->$get_pk()) { $self->{STATE_IN_DB()} = 1; } } elsif(@pk_values == @pk_methods) { $self->{STATE_IN_DB()} = 1; } elsif(!$using_pk_placeholders) { my $have_pk = 1; my @pk_set_methods = $meta->primary_key_column_mutator_names; my $i = 0; my $got_last_insert_id = 0; foreach my $pk (@pk_methods) { unless(defined $self->$pk()) { # XXX: This clause assumes that any db that uses last_insert_id # XXX: can only have one such id per table. This is currently # XXX: true for the supported dbs: MySQL, Pg, SQLite, Informix. if($got_last_insert_id) { $have_pk = 0; last; } elsif(my $pk_val = $db->last_insertid_from_sth($sth)) { my $set_pk = $pk_set_methods[$i]; $self->$set_pk($pk_val); $got_last_insert_id = 1; } else { $have_pk = 0; last; } } $i++; } $self->{STATE_IN_DB()} = $have_pk; } #if($started_new_tx) #{ # $db->commit or die $db->error; #} }; $error = $@; } if($error) { $self->error(ref $error ? $error : "insert() - $error"); #$db->rollback or warn $db->error if($started_new_tx); $self->meta->handle_error($self); return 0; } $self->{MODIFIED_COLUMNS()} = {}; return $self || 1; } my %CASCADE_VALUES = (delete => 'delete', null => 'null', 1 => 'delete'); sub delete { my($self, %args) = @_; my $meta = $self->meta; my $prepare_cached = exists $args{'prepare_cached'} ? $args{'prepare_cached'} : $meta->dbi_prepare_cached; local $self->{STATE_SAVING()} = 1; my @pk_methods = $meta->primary_key_column_accessor_names; my @pk_values = grep { defined } map { $self->$_() } @pk_methods; unless(@pk_values == @pk_methods) { $self->error("Cannot delete " . ref($self) . " without a primary key (" . join(', ', @pk_methods) . ')'); $self->meta->handle_error($self); return 0; } # Totally separate code path for cascaded delete if(my $cascade = $args{'cascade'}) { unless(exists $CASCADE_VALUES{$cascade}) { Carp::croak "Illegal value for 'cascade' parameter: '$cascade'. ", "Valid values are 'delete', 'null', and '1'"; } $cascade = $CASCADE_VALUES{$cascade}; my $mgr_error_mode = Rose::DB::Object::Manager->error_mode; my($db, $started_new_tx, $error); TRY: { local $@; eval { $db = $self->db; my $meta = $self->meta; my $ret = $db->begin_work; unless(defined $ret) { die 'Could not begin transaction before deleting with cascade - ', $db->error; } $started_new_tx = ($ret == IN_TRANSACTION) ? 0 : 1; unless($self->{STATE_IN_DB()}) { $self->load or die "Could not load in preparation for cascading delete: ", $self->error; } Rose::DB::Object::Manager->error_mode('fatal'); my @one_to_one_rels; # Process all the rows for each "... to many" relationship REL: foreach my $relationship ($meta->relationships) { my $rel_type = $relationship->type; if($rel_type eq 'one to many') { my $column_map = $relationship->column_map; my @query; foreach my $local_column (keys %$column_map) { my $foreign_column = $column_map->{$local_column}; my $method = $meta->column_accessor_method_name($local_column); my $value = $self->$method(); # XXX: Comment this out to allow null keys next REL unless(defined $value); push(@query, $foreign_column => $value); } if($cascade eq 'delete') { Rose::DB::Object::Manager->delete_objects( db => $db, object_class => $relationship->class, where => \@query); } elsif($cascade eq 'null') { my %set = map { $_ => undef } values(%$column_map); Rose::DB::Object::Manager->update_objects( db => $db, object_class => $relationship->class, set => \%set, where => \@query); } else { Carp::confess "Illegal cascade value '$cascade' snuck through" } } elsif($rel_type eq 'many to many') { my $map_class = $relationship->map_class; my $map_from = $relationship->map_from; my $map_from_relationship = $map_class->meta->foreign_key($map_from) || $map_class->meta->relationship($map_from) || Carp::confess "No foreign key or 'many to one' relationship ", "named '$map_from' in class $map_class"; my $key_columns = $map_from_relationship->key_columns; my @query; # "Local" here means "local to the mapping table" foreach my $local_column (keys %$key_columns) { my $foreign_column = $key_columns->{$local_column}; my $method = $meta->column_accessor_method_name($foreign_column); my $value = $self->$method(); # XXX: Comment this out to allow null keys next REL unless(defined $value); push(@query, $local_column => $value); } if($cascade eq 'delete') { Rose::DB::Object::Manager->delete_objects( db => $db, object_class => $map_class, where => \@query); } elsif($cascade eq 'null') { my %set = map { $_ => undef } keys(%$key_columns); Rose::DB::Object::Manager->update_objects( db => $db, object_class => $map_class, set => \%set, where => \@query); } else { Carp::confess "Illegal cascade value '$cascade' snuck through" } } elsif($rel_type eq 'one to one') { push(@one_to_one_rels, $relationship); } } # Delete the object itself my $dbh = $db->dbh or die "Could not get dbh: ", $self->error; #local $self->{STATE_SAVING()} = 1; local $dbh->{'RaiseError'} = 1; # $meta->prepare_delete_options (defunct) my $sth = $prepare_cached ? $dbh->prepare_cached($meta->delete_sql($db), undef, 3) : $dbh->prepare($meta->delete_sql($db)); $Debug && warn $meta->delete_sql($db), " - bind params: ", join(', ', @pk_values), "\n"; $sth->execute(@pk_values); unless($sth->rows > 0) { $self->error("Did not delete " . ref($self) . ' where ' . join(', ', @pk_methods) . ' = ' . join(', ', @pk_values)); } # Process all rows referred to by "one to one" foreign keys FK: foreach my $fk ($meta->foreign_keys) { next unless($fk->relationship_type eq 'one to one'); my $key_columns = $fk->key_columns; my @query; foreach my $local_column (keys %$key_columns) { my $foreign_column = $key_columns->{$local_column}; my $method = $meta->column_accessor_method_name($local_column); my $value = $self->$method(); # XXX: Comment this out to allow null keys next FK unless(defined $value); push(@query, $foreign_column => $value); } if($cascade eq 'delete') { Rose::DB::Object::Manager->delete_objects( db => $db, object_class => $fk->class, where => \@query); } elsif($cascade eq 'null') { my %set = map { $_ => undef } values(%$key_columns); Rose::DB::Object::Manager->update_objects( db => $db, object_class => $fk->class, set => \%set, where => \@query); } else { Carp::confess "Illegal cascade value '$cascade' snuck through" } } # Process all the rows for each "one to one" relationship REL: foreach my $relationship (@one_to_one_rels) { my $column_map = $relationship->column_map; my @query; foreach my $local_column (keys %$column_map) { my $foreign_column = $column_map->{$local_column}; my $method = $meta->column_accessor_method_name($local_column); my $value = $self->$method(); # XXX: Comment this out to allow null keys next REL unless(defined $value); push(@query, $foreign_column => $value); } if($cascade eq 'delete') { Rose::DB::Object::Manager->delete_objects( db => $db, object_class => $relationship->class, where => \@query); } elsif($cascade eq 'null') { my %set = map { $_ => undef } values(%$column_map); Rose::DB::Object::Manager->update_objects( db => $db, object_class => $relationship->class, set => \%set, where => \@query); } else { Carp::confess "Illegal cascade value '$cascade' snuck through" } } if($started_new_tx) { $db->commit or die $db->error; } }; $error = $@; } if($error) { Rose::DB::Object::Manager->error_mode($mgr_error_mode); $self->error(ref $error ? $error : "delete() with cascade - $error"); $db->rollback if($db && $started_new_tx); $self->meta->handle_error($self); return 0; } Rose::DB::Object::Manager->error_mode($mgr_error_mode); $self->{STATE_IN_DB()} = 0; return 1; } else { my $db = $self->db or return 0; my $dbh = $db->dbh or return 0; my $error; TRY: { local $@; eval { #local $self->{STATE_SAVING()} = 1; local $dbh->{'RaiseError'} = 1; # $meta->prepare_delete_options (defunct) my $sth = $prepare_cached ? $dbh->prepare_cached($meta->delete_sql($db), undef, 3) : $dbh->prepare($meta->delete_sql($db)); $Debug && warn $meta->delete_sql($db), " - bind params: ", join(', ', @pk_values), "\n"; $sth->execute(@pk_values); unless($sth->rows > 0) { $self->error("Did not delete " . ref($self) . ' where ' . join(', ', @pk_methods) . ' = ' . join(', ', @pk_values)); } }; $error = $@; } if($error) { $self->error(ref $error ? $error : "delete() - $error"); $self->meta->handle_error($self); return 0; } $self->{STATE_IN_DB()} = 0; return 1; } } our $AUTOLOAD; sub AUTOLOAD { my $self = shift; my $msg = ''; TRY: { local $@; # Not sure if this will ever be used, but just in case... eval { my @fks = $self->meta->deferred_foreign_keys; my @rels = $self->meta->deferred_relationships; if(@fks || @rels) { my $class = ref $self; my $tmp_msg =<<"EOF"; Methods for the following relationships and foreign keys were deferred and then never actually created in the class $class. TYPE NAME ---- ---- EOF my $found = 0; foreach my $thing (@fks, @rels) { next unless($thing->parent->class eq $class); $found++; my $type = $thing->isa('Rose::DB::Object::Metadata::Relationship') ? 'Relationship' : $thing->isa('Rose::DB::Object::Metadata::ForeignKey') ? 'Foreign Key' : '???'; $tmp_msg .= sprintf("%-15s %s\n", $type, $thing->name); } $msg = "\n\n$tmp_msg\n" if($tmp_msg && $found); } }; # XXX: Ignoring errors } my $method_type = ref $self ? 'object' : 'class'; if($AUTOLOAD =~ /^(.+)::(.+)$/) { Carp::confess qq(Can't locate $method_type method "$2" via package "$1"$msg); } else # not reached? { Carp::confess qq(Can't locate $method_type method $AUTOLOAD$msg); } } sub DESTROY { } # { # my($self) = shift; # # if($self->{FLAG_DB_IS_PRIVATE()}) # { # if(my $db = $self->{'db'}) # { # #$Debug && warn "$self DISCONNECT\n"; # $db->disconnect; # } # } # } 1; __END__ =head1 NAME Rose::DB::Object - Extensible, high performance object-relational mapper (ORM). =head1 SYNOPSIS ## For an informal overview of Rose::DB::Object, please ## see the Rose::DB::Object::Tutorial documentation. The ## reference documentation follows. ## First, set up your Rose::DB data sources, otherwise you ## won't be able to connect to the database at all. See ## the Rose::DB documentation for more information. For ## a quick start, see the Rose::DB::Tutorial documentation. ## ## Create classes - two possible approaches: ## # # 1. Automatic configuration # package Category; use base qw(Rose::DB::Object); __PACKAGE__->meta->setup ( table => 'categories', auto => 1, ); ... package Price; use base qw(Rose::DB::Object); __PACKAGE__->meta->setup ( table => 'prices', auto => 1, ); ... package Product; use base qw(Rose::DB::Object); __PACKAGE__->meta->setup ( table => 'products', auto => 1, ); # # 2. Manual configuration # package Category; use base qw(Rose::DB::Object); __PACKAGE__->meta->setup ( table => 'categories', columns => [ id => { type => 'int', primary_key => 1 }, name => { type => 'varchar', length => 255 }, description => { type => 'text' }, ], unique_key => 'name', ); ... package Price; use base qw(Rose::DB::Object); __PACKAGE__->meta->setup ( table => 'prices', columns => [ id => { type => 'int', primary_key => 1 }, price => { type => 'decimal' }, region => { type => 'char', length => 3 }, product_id => { type => 'int' } ], unique_key => [ 'product_id', 'region' ], ); ... package Product; use base qw(Rose::DB::Object); __PACKAGE__->meta->setup ( table => 'products', columns => [ id => { type => 'int', primary_key => 1 }, name => { type => 'varchar', length => 255 }, description => { type => 'text' }, category_id => { type => 'int' }, status => { type => 'varchar', check_in => [ 'active', 'inactive' ], default => 'inactive', }, start_date => { type => 'datetime' }, end_date => { type => 'datetime' }, date_created => { type => 'timestamp', default => 'now' }, last_modified => { type => 'timestamp', default => 'now' }, ], unique_key => 'name', foreign_keys => [ category => { class => 'Category', key_columns => { category_id => 'id' }, }, ], relationships => [ prices => { type => 'one to many', class => 'Price', column_map => { id => 'product_id' }, }, ], ); ... # # Example usage # $product = Product->new(id => 123, name => 'GameCube', status => 'active', start_date => '11/5/2001', end_date => '12/1/2007', category_id => 5); $product->save; ... $product = Product->new(id => 123); $product->load; # Load foreign object via "one to one" relationship print $product->category->name; $product->end_date->add(days => 45); $product->save; ... $product = Product->new(id => 456); $product->load; # Load foreign objects via "one to many" relationship print join ' ', $product->prices; ... =head1 DESCRIPTION L is a base class for objects that encapsulate a single row in a database table. L-derived objects are sometimes simply called "L objects" in this documentation for the sake of brevity, but be assured that derivation is the only reasonable way to use this class. L inherits from, and follows the conventions of, L. See the L documentation for more information. For an informal overview of this module distribution, consult the L. =head2 Restrictions L objects can represent rows in almost any database table, subject to the following constraints. =over 4 =item * The database server must be supported by L. =item * The database table must have a primary key. =item * The primary key must not allow null values in any of its columns. =back Although the list above contains the only hard and fast rules, there may be other realities that you'll need to work around. The most common example is the existence of a column name in the database table that conflicts with the name of a method in the L API. There are two possible workarounds: either explicitly alias the column, or define a L. See the L and L methods in the L documentation for more details. There are also varying degrees of support for data types in each database server supported by L. If you have a table that uses a data type not supported by an existing L-derived class, you will have to write your own column class and then map it to a type name using L's L method, yada yada. (Or, of course, you can map the new type to an existing column class.) The entire framework is extensible. This module distribution contains straight-forward implementations of the most common column types, but there's certainly more that can be done. Submissions are welcome. =head2 Features L provides the following functions: =over 4 =item * Create a row in the database by saving a newly constructed object. =item * Initialize an object by loading a row from the database. =item * Update a row by saving a modified object back to the database. =item * Delete a row from the database. =item * Fetch an object referred to by a foreign key in the current object. (i.e., "one to one" and "many to one" relationships.) =item * Fetch multiple objects that refer to the current object, either directly through foreign keys or indirectly through a mapping table. (i.e., "one to many" and "many to many" relationships.) =item * Load an object along with "foreign objects" that are related through any of the supported relationship types. =back Objects can be loaded based on either a primary key or a unique key. Since all tables fronted by Ls must have non-null primary keys, insert, update, and delete operations are done based on the primary key. In addition, its sibling class, L, can do the following: =over 4 =item * Fetch multiple objects from the database using arbitrary query conditions, limits, and offsets. =item * Iterate over a list of objects, fetching from the database in response to each step of the iterator. =item * Fetch objects along with "foreign objects" (related through any of the supported relationship types) in a single query by automatically generating the appropriate SQL join(s). =item * Count the number of objects that match a complex query. =item * Update objects that match a complex query. =item * Delete objects that match a complex query. =back L can be subclassed and used separately (the recommended approach), or it can create object manager methods within a L subclass. See the L documentation for more information. L can parse, coerce, inflate, and deflate column values on your behalf, providing the most convenient possible data representations on the Perl side of the fence, while allowing the programmer to completely forget about the ugly details of the data formats required by the database. Default implementations are included for most common column types, and the framework is completely extensible. Finally, the L can be used to automatically create a suite of L and L subclasses based on the contents of the database. =head2 Configuration Before L can do any useful work, you must register at least one L data source. By default, L instantiates a L object by passing no arguments to its constructor. (See the L method.) If you register a L data source using the default type and domain, this will work fine. Otherwise, you must override the L method in your L subclass and have it return the appropriate L-derived object. To define your own L-derived class, you must describe the table that your class will act as a front-end for. This is done through the L object associated with each L-derived class. The metadata object is accessible via L's L method. Metadata objects can be populated manually or automatically. Both techniques are shown in the L above. The automatic mode works by asking the database itself for the information. There are some caveats to this approach. See the L section of the L documentation for more information. =head2 Serial and Auto-Incremented Columns Most databases provide a way to use a series of arbitrary integers as primary key column values. Some support a native C column data type. Others use a special auto-increment column attribute. L supports at least one such serial or auto-incremented column type in each supported database. In all cases, the L-derived class setup is the same: package My::DB::Object; ... __PACKAGE__->meta->setup ( columns => [ id => { type => 'serial', primary_key => 1, not_null => 1 }, ... ], ... ); (Note that the column doesn't have to be named "id"; it can be named anything.) If the database column uses big integers, use "L" column C instead. Given the column metadata definition above, L will automatically generate and/or retrieve the primary key column value when an object is Ld. Example: $o = My::DB::Object->new(name => 'bud'); # no id specified $o->save; # new id value generated here print "Generated new id value: ", $o->id; This will only work, however, if the corresponding column definition in the database is set up correctly. The exact technique varies from vendor to vendor. Below are examples of primary key column definitions that provide auto-generated values. There's one example for each of the databases supported by L. =over =item * PostgreSQL CREATE TABLE mytable ( id SERIAL PRIMARY KEY, ... ); =item * MySQL CREATE TABLE mytable ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, ... ); =item * SQLite CREATE TABLE mytable ( id INTEGER PRIMARY KEY AUTOINCREMENT, ... ); =item * Informix CREATE TABLE mytable ( id SERIAL NOT NULL PRIMARY KEY, ... ); =item * Oracle Since Oracle does not natively support a serial or auto-incremented column data type, an explicit sequence and trigger must be created to simulate the behavior. The sequence should be named according to this convention: CtableE_EcolumnE_seq>. For example, if the table is named C and the column is named C, then the sequence should be named C. Here's an example database setup. CREATE TABLE mytable ( id INT NOT NULL PRIMARY KEY, ... ); CREATE SEQUENCE mytable_id_seq; CREATE TRIGGER mytable_insert BEFORE INSERT ON mytable FOR EACH ROW BEGIN IF :new.id IS NULL THEN :new.id := mytable_id_seq.nextval; END IF; END; Note the conditional that checks if C<:new.id> is null, which allows the value of the C column to be set explicitly. If a non-NULL value for the C column is provided, then a new value is not pulled from the sequence. If the sequence is not named according to the CtableE_EcolumnE_seq> convention, you can specify the sequence name explicitly in the column metadata. Example: columns => [ id => { type => 'serial', primary_key => 1, not_null => 1, sequence => 'some_other_seq' }, ... =back If the table has a multi-column primary key or does not use a column type that supports auto-generated values, you can define a custom primary key generator function using the L method of the L-derived object that contains the metadata for this class. Example: package MyDBObject; use base qw(Rose::DB::Object); __PACKAGE__->meta->setup ( table => 'mytable', columns => [ k1 => { type => 'int', not_null => 1 }, k2 => { type => 'int', not_null => 1 }, name => { type => 'varchar', length => 255 }, ... ], primary_key_columns => [ 'k1', 'k2' ], primary_key_generator => sub { my($meta, $db) = @_; # Generate primary key values somehow my $k1 = ...; my $k2 = ...; return $k1, $k2; }, ); See the L documentation for more information on custom primary key generators. =head2 Inheritance Simple, single inheritance between L-derived classes is supported. (Multiple inheritance is not currently supported.) The first time the L for a given class is accessed, it is created by making a one-time "deep copy" of the base class's metadata object (as long that the base class has one or more L set). This includes all columns, relationships, foreign keys, and other metadata from the base class. From that point on, the subclass may add to or modify its metadata without affecting any other class. B When using perl 5.8.0 or later, the L module is highly recommended. If it's installed, it will be used to more efficiently clone base-class metadata objects. If the base class has already been L, the subclass must explicitly specify whether it wants to create a new set of column and relationship methods, or merely inherit the methods from the base class. If the subclass contains any metadata modifications that affect method creation, then it must create a new set of methods to reflect those changes. Finally, note that column types cannot be changed "in-place." To change a column type, delete the old column and add a new one with the same name. This can be done in one step with the L method. Example: package BaseClass; use base 'Rose::DB::Object'; __PACKAGE__->meta->setup ( table => 'objects', columns => [ id => { type => 'int', primary_key => 1 }, start => { type => 'scalar' }, ], ); ... package SubClass; use base 'BaseClass'; # Set a default value for this column. __PACKAGE__->meta->column('id')->default(123); # Change the "start" column into a datetime column. __PACKAGE__->meta->replace_column(start => { type => 'datetime' }); # Initialize, replacing any inherited methods with newly created ones __PACKAGE__->meta->initialize(replace_existing => 1); ... $b = BaseClass->new; $id = $b->id; # undef $b->start('1/2/2003'); print $b->start; # '1/2/2003' (plain string) $s = SubClass->new; $id = $s->id; # 123 $b->start('1/2/2003'); # Value is converted to a DateTime object print $b->start->strftime('%B'); # 'January' To preserve all inherited methods in a subclass, do this instead: package SubClass; use base 'BaseClass'; __PACKAGE__->meta->initialize(preserve_existing => 1); =head2 Error Handling Error handling for L-derived objects is controlled by the L method of the L object associated with the class (accessible via the L method). The default setting is "fatal", which means that L methods will L if they encounter an error. B The error return values described in the L documentation are only relevant when the error mode is set to something "non-fatal." In other words, if an error occurs, you'll never see any of those return values if the selected error mode Ls or Ls or otherwise throws an exception when an error occurs. =head1 CONSTRUCTOR =over 4 =item B Returns a new L constructed according to PARAMS, where PARAMS are name/value pairs. Any object method is a valid parameter name. =back =head1 CLASS METHODS =over 4 =item B Returns the L-derived object used to access the database in the absence of an explicit L value. The default implementation simply calls Lnew()|Rose::DB/new> with no arguments. Override this method in your subclass in order to use a different default data source. B This method must be callable as both an object method and a class method. =item B Returns the L-derived object associated with this class. This object describes the database table whose rows are fronted by this class: the name of the table, its columns, unique keys, foreign keys, etc. See the L documentation for more information. =item B Return the name of the L-derived class used to store this object's metadata. Subclasses should override this method if they want to use a custom L subclass. (See the source code for L for an example of this.) =back =head1 OBJECT METHODS =over 4 =item B Get or set the L object used to access the database that contains the table whose rows are fronted by the L-derived class. If it does not already exist, this object is created with a simple, argument-less call to Cnew()>. To override this default in a subclass, override the L method and return the L to be used as the new default. =item B Returns the L-derived object used to access the database in the absence of an explicit L value. The default implementation simply calls Lnew()|Rose::DB/new> with no arguments. Override this method in your subclass in order to use a different default data source. B This method must be callable as both an object method and a class method. =item B Get or set the L database handle contained in L. =item B Delete the row represented by the current object. The object must have been previously loaded from the database (or must otherwise have a defined primary key value) in order to be deleted. Returns true if the row was deleted or did not exist, false otherwise. PARAMS are optional name/value pairs. Valid PARAMS are: =over 4 =item B Also process related rows. TYPE must be "delete", "null", or "1". The value "1" is an alias for "delete". Passing an illegal TYPE value will cause a fatal error. For each "one to many" relationship, all of the rows in the foreign ("many") table that reference the current object ("one") will be deleted in "delete" mode, or will have the column(s) that reference the current object set to NULL in "null" mode. For each "many to many" relationship, all of the rows in the "mapping table" that reference the current object will deleted in "delete" mode, or will have the columns that reference the two tables that the mapping table maps between set to NULL in "null" mode. For each "one to one" relationship or foreign key with a "one to one" L, all of the rows in the foreign table that reference the current object will deleted in "delete" mode, or will have the column(s) that reference the current object set to NULL in "null" mode. In all modes, if the L is not currently in a transaction, a new transaction is started. If any part of the cascaded delete fails, the transaction is rolled back. =item B If true, then L's L method will be used (instead of the L method) when preparing the SQL statement that will delete the object. If omitted, the default value is determined by the L's L class method. =back The cascaded delete feature described above plays it safe by only deleting rows that are not referenced by any other rows (according to the metadata provided by each L-derived class). I B that you implement "cascaded delete" in the database itself, rather than using this feature. It will undoubtedly be faster and more robust than doing it "client-side." You may also want to cascade only to certain tables, or otherwise deviate from the "safe" plan. If your database supports automatic cascaded delete and/or triggers, please consider using these features. =item B Returns the text message associated with the last error that occurred. =item B Insert the current object to the database table. This method should only be used when you're absolutely sure that you want to B the current object to be inserted, rather than updated. It is recommended that you use the L method instead of this one in most circumstances. The L method will "do the right thing," executing an insert or update as appropriate for the current situation. PARAMS are optional name/value pairs. Valid PARAMS are: =over 4 =item B If true, then only the columns whose values have been modified will be included in the insert query. Otherwise, all columns will be included. Note that any column that has a L value set in its L is considered "modified" during an insert operation. If omitted, the default value of this parameter is determined by the L's L class method, which returns false by default. =item B If true, then L's L method will be used (instead of the L method) when preparing the SQL statement that will insert the object. If omitted, the default value is determined by the L's L class method. =back Returns true if the row was inserted successfully, false otherwise. The true value returned on success will be the object itself. If the object Ls its boolean value such that it is not true, then a true value will be returned instead of the object itself. =item B Load a row from the database table, initializing the object with the values from that row. An object can be loaded based on either a primary key or a unique key. Returns true if the row was loaded successfully, undef if the row could not be loaded due to an error, or zero (0) if the row does not exist. The true value returned on success will be the object itself. If the object Ls its boolean value such that it is not true, then a true value will be returned instead of the object itself. When loading based on a unique key, unique keys are considered in the order in which they were defined in the L for this class. If the object has defined values for every column in a unique key, then that key is used. If no such key is found, then the first key for which the object has at least one defined value is used. PARAMS are optional name/value pairs. Valid PARAMS are: =over 4 =item B If true, this parameter is translated to be the equivalent of passing the L parameter and setting the C to C. For example, these are both equivalent: $object->load(for_update => 1); $object->load(lock => { type => 'for update' }); See the L parameter below for more information. =item B Load the object using some form of locking. These lock directives have database-specific behavior and not all directives are supported by all databases. The value should be a reference to a hash or a TYPE string, which is equivalent to setting the value of the C key in the hash reference form. For example, these are both equivalent: $object->load(lock => 'for update'); $object->load(lock => { type => 'for update' }); Valid hash keys are: =over 4 =item B A reference to an array of column names to lock. References to scalars will be de-referenced and used as-is, included literally in the SQL locking clause. =item C If true, do not wait to acquire the lock. If supported, this is usually by adding a C directive to the SQL. =item C The lock type. Valid values for TYPE are C and C. This parameter is required unless the L parameter was passed with a true value. =item C Wait for the specified TIME (generally seconds) before giving up acquiring the lock. If supported, this is usually by adding a C clause to the SQL. =back =item B If true, then all columns will be fetched from the database, even L columns. If omitted, the default is false. =item B If true, then L's L method will be used (instead of the L method) when preparing the SQL query that will load the object. If omitted, the default value is determined by the L's L class method. =item B If this parameter is passed with a true value, and if the load failed because the row was L, then the L setting is ignored and zero (0) is returned. In the absence of an explicitly set value, this parameter defaults to the value returned my the L's L method. =item B Use the unique key Ld KEY to load the object. This overrides the unique key selection process described above. The key must have a defined value in at least one of its L. =item B Load the object and the specified "foreign objects" simultaneously. OBJECTS should be a reference to an array of L or L names. =back B If you are going to override the L method in your subclass, you I pass an I as the first argument to the method, rather than passing a copy of the object reference. Example: # This is the CORRECT way to override load() while still # calling the base class version of the method. sub load { my $self = $_[0]; # Copy, not shift ... # Do your stuff shift->SUPER::load(@_); # Call superclass } Now here's the wrong way: # This is the WRONG way to override load() while still # calling the base class version of the method. sub load { my $self = shift; # WRONG! The alias to the object is now lost! ... # Do your stuff $self->SUPER::load(@_); # This won't work right! } This requirement exists in order to preserve some sneaky object-replacement optimizations in the base class implementation of L. At some point, those optimizations may change or go away. But if you follow these guidelines, your code will continue to work no matter what. =item B Returns true if the previous call to L failed because a row in the database table with the specified primary or unique key did not exist, false otherwise. =item B Returns the L object associated with this class. This object describes the database table whose rows are fronted by this class: the name of the table, its columns, unique keys, foreign keys, etc. See the L documentation for more information. =item B Save the current object to the database table. In the absence of PARAMS, if the object was previously Led from the database, the row will be Ld. Otherwise, a new row will be Led. PARAMS are name/value pairs. Valid PARAMS are listed below. Actions associated with sub-objects that were added or deleted using one of the "*_on_save" relationship or foreign key method types are also performed when this method is called. If there are any such actions to perform, a new transaction is started if the L is not already in one, and L is called if any of the actions fail during the L. Example: $product = Product->new(name => 'Sled'); $vendor = Vendor->new(name => 'Acme'); $product->vendor($vendor); # Product and vendor records created and linked together, # all within a single transaction. $product->save; See the "making methods" sections of the L and L documentation for a description of the "method map" associated with each relationship and foreign key. Only the actions initiated through one of the "*_on_save" method types are handled when L is called. See the documentation for each individual "*_on_save" method type for more specific information. Valid parameters to L are: =over 4 =item B If true, then sub-objects related to this object through a foreign key or relationship that have been previously loaded using methods called on this object and that contain unsaved changes will be L after the parent object is saved. This proceeds recursively through all sub-objects. (All other parameters to the original call to L are also passed on when saving sub-objects.) All database operations are done within a single transaction. If the L is not currently in a transaction, a new transaction is started. If any part of the cascaded save fails, the transaction is rolled back. If omitted, the default value of this parameter is determined by the L's L class method, which returns false by default. Example: $p = Product->new(id => 123)->load; print join(', ', $p->colors); # related Color objects loaded $p->colors->[0]->code('zzz'); # one Color object is modified # The Product object and the modified Color object are saved $p->save(cascade => 1); =item B If true, then only the columns whose values have been modified will be included in the insert or update query. Otherwise, all eligible columns will be included. Note that any column that has a L value set in its L is considered "modified" during an insert operation. If omitted, the default value of this parameter is determined by the L's L class method on update, and the L class method on insert, both of which return false by default. =item B If set to a true value, then an L is attempted, regardless of whether or not the object was previously Led from the database. =item B If true, then L's L method will be used (instead of the L method) when preparing the SQL statement that will save the object. If omitted, the default value is determined by the L's L class method. =item B If set to a true value, then an L is attempted, regardless of whether or not the object was previously Led from the database. =back It is an error to pass both the C and C parameters in a single call. Returns true if the row was inserted or updated successfully, false otherwise. The true value returned on success will be the object itself. If the object Ls its boolean value such that it is not true, then a true value will be returned instead of the object itself. If an insert was performed and the primary key is a single column that supports auto-generated values, then the object accessor for the primary key column will contain the auto-generated value. See the L section for more information. =item B Update the current object in the database table. This method should only be used when you're absolutely sure that you want to B the current object to be updated, rather than inserted. It is recommended that you use the L method instead of this one in most circumstances. The L method will "do the right thing," executing an insert or update as appropriate for the current situation. PARAMS are optional name/value pairs. Valid PARAMS are: =over 4 =item B If true, then only the columns whose values have been modified will be updated. Otherwise, all columns whose values have been loaded from the database will be updated. If omitted, the default value of this parameter is determined by the L's L class method, which returns false by default. =item B If true, then L's L method will be used (instead of the L method) when preparing the SQL statement that will insert the object. If omitted, the default value of this parameter is determined by the L's L class method. =back Returns true if the row was updated successfully, false otherwise. The true value returned on success will be the object itself. If the object Ls its boolean value such that it is not true, then a true value will be returned instead of the object itself. =back =head1 RESERVED METHODS As described in the L documentation, each column in the database table has an associated get/set accessor method in the L. Since the L API already defines many methods (L, L, L, etc.), accessor methods for columns that share the name of an existing method pose a problem. The solution is to alias such columns using L's L method. Here is a list of method names reserved by the L API. If you have a column with one of these names, you must alias it. db dbh delete DESTROY error init_db _init_db insert load meta meta_class not_found save update Note that not all of these methods are public. These methods do not suddenly become public just because you now know their names! Remember the stated policy of the L web application framework: if a method is not documented, it does not exist. (And no, the list of method names above does not constitute "documentation.") =head1 DEVELOPMENT POLICY The L applies to this, and all C modules. Please install L from CPAN and then run "C" for more information. =head1 SUPPORT For an informal overview of L, consult the L. perldoc Rose::DB::Object::Tutorial Any L questions or problems can be posted to the L mailing list. To subscribe to the list or view the archives, go here: L Although the mailing list is the preferred support mechanism, you can also email the author (see below) or file bugs using the CPAN bug tracking system: L There's also a wiki and other resources linked from the Rose project home page: L =head1 CONTRIBUTORS Bradley C Bailey, Graham Barr, Kostas Chatzikokolakis, David Christensen, Lucian Dragus, Justin Ellison, Perrin Harkins, Cees Hek, Benjamin Hitz, Dave Howorth, Peter Karman, Ed Loehr, Adam Mackler, Michael Reece, Thomas Whaples, Douglas Wilson, Teodor Zlatanov =head1 AUTHOR John C. Siracusa (siracusa@gmail.com) =head1 LICENSE Copyright (c) 2010 by John C. Siracusa. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Rose-DB-Object-0.810/lib/Rose/DB/Object/Cached.pm000755 000765 000120 00000034313 12207467220 021073 0ustar00johnadmin000000 000000 package Rose::DB::Object::Cached; use strict; use Carp(); use Rose::DB::Object; our @ISA = qw(Rose::DB::Object); use Rose::DB::Object::Constants qw(STATE_IN_DB); our $VERSION = '0.785'; our $Debug = 0; # Anything that cannot be in a column name will work for these use constant PK_SEP => "\0\0"; use constant UK_SEP => "\0\0"; # Try to pick a very unlikely value to stand in for undef in # the stringified multi-column unique key value use constant UNDEF => "\1\2undef\2\1"; sub remember { my($self) = shift; my $class = ref $self; my $meta = $self->meta; my $pk = join(PK_SEP, grep { defined } map { $self->$_() } $meta->primary_key_column_accessor_names); no strict 'refs'; my $ttl_secs = $class->meta->cached_objects_expire_in || 0; my $loaded = $ttl_secs ? time : 0; ${"${class}::Objects_By_Id"}{$pk} = $self; if($ttl_secs) { ${"${class}::Objects_By_Id_Loaded"}{$pk} = $loaded; } my $accessor = $meta->column_accessor_method_names_hash; foreach my $cols ($self->meta->unique_keys_column_names) { no warnings; my $key_name = join(UK_SEP, @$cols); my $key_value = join(UK_SEP, grep { defined($_) ? $_ : UNDEF } map { my $m = $accessor->{$_}; $self->$m() } @$cols); ${"${class}::Objects_By_Key"}{$key_name}{$key_value} = $self; ${"${class}::Objects_Keys"}{$pk}{$key_name} = $key_value; if($ttl_secs) { ${"${class}::Objects_By_Key_Loaded"}{$key_name}{$key_value} = $loaded; } } }; # This constant is not arbitrary. It must be defined and false. # I'm playing games with return values, but this is all internal # anyway and can change at any time. use constant CACHE_EXPIRED => 0; sub __xrdbopriv_get_object { my($class) = ref $_[0] || $_[0]; my $ttl_secs = $class->meta->cached_objects_expire_in; if(@_ == 2) { my($pk) = $_[1]; no strict 'refs'; no warnings; if(${"${class}::Objects_By_Id"}{$pk}) { if($ttl_secs && (time - ${"${class}::Objects_By_Id_Loaded"}{$pk}) >= $ttl_secs) { delete ${"${class}::Objects_By_Id"}{$pk}; return CACHE_EXPIRED; } return ${"${class}::Objects_By_Id"}{$pk}; } return undef; } else { my($key_name, $key_value) = ($_[1], $_[2]); no strict 'refs'; no warnings; if(${"${class}::Objects_By_Key"}{$key_name}{$key_value}) { if($ttl_secs && (time - ${"${class}::Objects_By_Key_Loaded"}{$key_name}{$key_value}) >= $ttl_secs) { delete ${"${class}::Objects_By_Key_Loaded"}{$key_name}{$key_value}; return undef; # cache expired } ${"${class}::Objects_By_Key"}{$key_name}{$key_value}->remember(); return ${"${class}::Objects_By_Key"}{$key_name}{$key_value}; } return undef; } }; sub load { # XXX: Must maintain alias to actual "self" object arg my %args = (self => @_); # faster than @_[1 .. $#_]; unless(delete $args{'refresh'}) { my $pk = join(PK_SEP, grep { defined } map { $_[0]->$_() } $_[0]->meta->primary_key_column_accessor_names); my $object = __xrdbopriv_get_object($_[0], $pk); if($object) { $_[0] = $object; $_[0]->{STATE_IN_DB()} = 1; return $_[0] || 1; } elsif(!(defined $object && $object == CACHE_EXPIRED)) { my $meta = $_[0]->meta; my $accessor = $meta->column_accessor_method_names_hash; foreach my $cols ($meta->unique_keys_column_names) { no warnings; my $key_name = join(UK_SEP, @$cols); my $key_value = join(UK_SEP, grep { defined($_) ? $_ : UNDEF } map { my $m = $accessor->{$_}; $_[0]->$m() } @$cols); if(my $object = __xrdbopriv_get_object($_[0], $key_name, $key_value)) { $_[0] = $object; $_[0]->{STATE_IN_DB()} = 1; return $_[0] || 1; } } } } my $ret = $_[0]->SUPER::load(%args); $_[0]->remember if($ret); return $ret; } sub insert { my($self) = shift; my $ret = $self->SUPER::insert(@_); return $ret unless($ret); $self->remember; return $ret; } sub update { my($self) = shift; my $ret = $self->SUPER::update(@_); return $ret unless($ret); $self->remember; return $ret; } sub delete { my($self) = shift; my $ret = $self->SUPER::delete(@_); $self->forget if($ret); return $ret; } sub forget { my($self) = shift; my $class = ref $self; my $pk = join(PK_SEP, grep { defined } map { $self->$_() } $self->meta->primary_key_column_accessor_names); no strict 'refs'; delete ${"${class}::Objects_By_Id"}{$pk}; foreach my $cols ($self->meta->unique_keys_column_names) { no warnings; my $key_name = join(UK_SEP, @$cols); my $key_value = ${"${class}::Objects_Keys"}{$pk}{$key_name}; delete ${"${class}::Objects_By_Key"}{$key_name}{$key_value}; } delete ${"${class}::Objects_Keys"}{$pk}; return 1; } sub remember_by_primary_key { my($self) = shift; my $class = ref $self; my $pk = join(PK_SEP, grep { defined } map { $self->$_() } $self->meta->primary_key_column_accessor_names); no strict 'refs'; ${"${class}::Objects_By_Id"}{$pk} = $self; } sub remember_all { my($class) = shift; require Rose::DB::Object::Manager; my(undef, %args) = Rose::DB::Object::Manager->normalize_get_objects_args(@_); my $objects = Rose::DB::Object::Manager->get_objects( object_class => $class, share_db => 0, %args); foreach my $object (@$objects) { $object->remember; } return @$objects if(defined wantarray); } # Code borrowed from Cache::Cache my %Expiration_Units = ( map(($_, 1), qw(s sec secs second seconds)), map(($_, 60), qw(m min mins minute minutes)), map(($_, 60*60), qw(h hr hrs hour hours)), map(($_, 60*60*24), qw(d day days)), map(($_, 60*60*24*7), qw(w wk wks week weeks)), map(($_, 60*60*24*365), qw(y yr yrs year years)) ); sub clear_object_cache { my($class) = ref($_[0]) || $_[0]; no strict 'refs'; %{"${class}::Objects_By_Id"} = (); %{"${class}::Objects_By_Key"} = (); %{"${class}::Objects_Keys"} = (); if($class->cached_objects_expire_in) { %{"${class}::Objects_By_Key_Loaded"} = (); %{"${class}::Objects_By_Id_Loaded"} = (); } return 1; } sub cached_objects_expire_in { my($class) = shift; $class = ref($class) if(ref($class)); no strict 'refs'; return ${"${class}::Cache_Expires"} ||= 0 unless(@_); my $arg = shift; my $secs; if($arg =~ /^now$/i) { $class->forget_all; $secs = 0; } elsif($arg =~ /^never$/) { $secs = 0; } elsif($arg =~ /^\s*([+-]?(?:\d+|\d*\.\d*))\s*$/) { $secs = $arg; } elsif($arg =~ /^\s*([+-]?(?:\d+(?:\.\d*)?|\d*\.\d+))\s*(\w*)\s*$/ && exists $Expiration_Units{$2}) { $secs = $Expiration_Units{$2} * $1; } else { Carp::croak("Invalid cache expiration time: '$arg'"); } return ${"${class}::Cache_Expires"} = $secs; } 1; __END__ =head1 NAME Rose::DB::Object::Cached - Memory cached object representation of a single row in a database table. =head1 SYNOPSIS package Category; use base 'Rose::DB::Object::Cached'; __PACKAGE__->meta->setup ( table => 'categories', columns => [ id => { type => 'int', primary_key => 1 }, name => { type => 'varchar', length => 255 }, description => { type => 'text' }, ], unique_key => 'name', ); ... $cat1 = Category->new(id => 123, name => 'Art'); $cat1->save or die $category->error; $cat2 = Category->new(id => 123); # This will load from the memory cache, not the database $cat2->load or die $cat2->error; # $cat2 is the same object as $cat1 print "Yep, cached" if($cat1 eq $cat2); # No, really, it's the same object $cat1->name('Blah'); print $cat2->name; # prints "Blah" # The object cache supports time-based expiration Category->cached_objects_expire_in('15 minutes'); $cat1 = Category->new(id => 123); $cat1->save or $cat1->die; $cat1->load; # loaded from cache $cat2 = Category->new(id => 123); $cat2->load; # loaded from cache <15 minutes pass> $cat3 = Category->new(id => 123); $cat3->load; # NOT loaded from cache ... =head1 DESCRIPTION C is a subclass of L that is backed by a write-through memory cache. Whenever an object is loaded from or saved to the database, it is cached in memory. Any subsequent attempt to load an object of the same class with the same primary key or unique key value(s) will give you the cached object instead of loading from the database. This means that I The L above highlights this fact. This class is most useful for encapsulating "read-only" rows, or other data that is updated very infrequently. In the C example above, it would be inefficient to repeatedly load category information in a long-running process (such as a mod_perl Apache web server) if that information changes infrequently. The memory cache can be cleared for an individual object or all objects of the same class. There is also support for simple time-based cache expiration. See the L and L methods for more information. Only the methods that are overridden or otherwise behaviorally modified are documented here. See the L documentation for the rest. =head1 CLASS METHODS =over 4 =item B This method controls the expiration of cached objects. If called with no arguments, the cache expiration limit in seconds is returned. If passed a DURATION, the cache expiration is set. Valid formats for DURATION are in the form "NUMBER UNIT" where NUMBER is a positive number and UNIT is one of the following: s sec secs second seconds m min mins minute minutes h hr hrs hour hours d day days w wk wks week weeks y yr yrs year years All formats of the DURATION argument are converted to seconds. Days are exactly 24 hours, weeks are 7 days, and years are 365 days. If an object was read from the database the specified number of seconds ago or earlier, it is purged from the cache and reloaded from the database the next time it is loaded. A L value of undef or zero means that nothing will ever expire from the object cache. This is the default. =item B Clear the memory cache for all objects of this class. =back =head1 OBJECT METHODS =over 4 =item B This method works like the L method from L except that it also calls the L method if the object was deleted successfully or did not exist in the first place. =item B Delete the current object from the memory cache. =item B Load an object based on either a primary key or a unique key. If the object exists in the memory cache, the current object "becomes" the cached object. See the L or L above for more information. If the object is not in the memory cache, it is loaded from the database. If the load succeeds, it is also written to the memory cache. PARAMS are name/value pairs, and are optional. Valid parameters are: =over 4 =item B If set to a true value, then the data is always loaded from the database rather than from the memory cache. If the load succeeds, the object replaces whatever was in the cache. If it fails, the cache is not modified. =back Returns true if the object was loaded successfully, false if the row could not be loaded or did not exist in the database. The true value returned on success will be the object itself. If the object Ls its boolean value such that it is not true, then a true value will be returned instead of the object itself. =item B This method does the same thing as the L L, except that it also saves the object to the memory cache if the insert succeeds. If it fails, the memory cache is not modified. =item B Save the current object to the memory cache I saving it to the database as well. Objects are cached based on their primary key values and all their unique key values. =item B Load and L all objects from this table, optionally filtered by PARAMS which can be any valid Lget_objects()|Rose::DB::Object::Manager/get_objects> parameters. Remembered objects will replace any previously cached objects with the same keys. =item B Save the current object to the memory cache I saving it to the database as well. The object will be cached based on its primary key value I. This is unlike the L method which caches objects based on their primary key values and all their unique key values. =item B This method does the same thing as the L L, except that it also saves the object to the memory cache if the save succeeds. If it fails, the memory cache is not modified. =item B This method does the same thing as the L L, except that it also saves the object to the memory cache if the update succeeds. If it fails, the memory cache is not modified. =back =head1 RESERVED METHODS In addition to the reserved methods listed in the L documentation, the following method names are also reserved for objects that inherit from this class: cached_objects_expire_in clear_object_cache forget remember remember_all remember_by_primary_key If you have a column with one of these names, you must alias it. See the L documentation for more information on column aliasing and reserved methods. =head1 AUTHOR John C. Siracusa (siracusa@gmail.com) =head1 LICENSE Copyright (c) 2010 by John C. Siracusa. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Rose-DB-Object-0.810/lib/Rose/DB/Object/Constants.pm000755 000765 000120 00000002512 11460576530 021701 0ustar00johnadmin000000 000000 package Rose::DB::Object::Constants; use strict; our $VERSION = '0.791'; require Exporter; our @ISA = qw(Exporter); our @EXPORT_OK = qw(PRIVATE_PREFIX META_ATTR_NAME ON_SAVE_ATTR_NAME LOADED_FROM_DRIVER FLAG_DB_IS_PRIVATE MODIFIED_COLUMNS MODIFIED_NP_COLUMNS SET_COLUMNS SAVING_FOR_LOAD STATE_IN_DB STATE_LOADING STATE_SAVING STATE_CLONING EXCEPTION_CODE_NO_KEY); our %EXPORT_TAGS = (all => \@EXPORT_OK); use constant PRIVATE_PREFIX => '__xrdbopriv'; use constant META_ATTR_NAME => PRIVATE_PREFIX . '_meta'; use constant ON_SAVE_ATTR_NAME => PRIVATE_PREFIX . '_on_save'; use constant LOADED_FROM_DRIVER => PRIVATE_PREFIX . '_loaded_from_driver'; use constant FLAG_DB_IS_PRIVATE => PRIVATE_PREFIX . '_db_is_private'; use constant MODIFIED_COLUMNS => PRIVATE_PREFIX . '_modified_columns'; use constant MODIFIED_NP_COLUMNS => PRIVATE_PREFIX . '_modified_np_columns'; use constant SET_COLUMNS => PRIVATE_PREFIX . '_set_columns'; use constant SAVING_FOR_LOAD => PRIVATE_PREFIX . '_saving_for_load'; use constant STATE_IN_DB => PRIVATE_PREFIX . '_in_db'; use constant STATE_LOADING => PRIVATE_PREFIX . '_loading'; use constant STATE_SAVING => PRIVATE_PREFIX . '_saving'; use constant STATE_CLONING => STATE_SAVING; use constant EXCEPTION_CODE_NO_KEY => 5; # arbitrary 1; Rose-DB-Object-0.810/lib/Rose/DB/Object/ConventionManager/000750 000765 000120 00000000000 12266514755 023002 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/lib/Rose/DB/Object/ConventionManager.pm000755 000765 000120 00000161234 12235452534 023347 0ustar00johnadmin000000 000000 package Rose::DB::Object::ConventionManager; use strict; use Carp(); use Scalar::Util(); use Rose::DB::Object::Metadata::ForeignKey; use Rose::DB::Object::Metadata::Object; our @ISA = qw(Rose::DB::Object::Metadata::Object); our $VERSION = '0.795'; our $Debug = 0; use Rose::Object::MakeMethods::Generic ( 'scalar --get_set_init' => [ 'singular_to_plural_function', 'plural_to_singular_function', ], boolean => [ tables_are_singular => { default => 0 }, force_lowercase => { default => 0 }, no_auto_sequences => { default => 0 }, ], ); *meta = \&Rose::DB::Object::Metadata::Object::parent; sub class_to_table_singular { my($self, $class) = @_; $class ||= $self->meta->class; my $table = $self->class_suffix($class); $table =~ s/([a-z]\d*|^\d+)([A-Z])/$1_$2/g; return lc $table; } sub class_suffix { my($self, $class) = @_; $class =~ /(\w+)$/; return $1; } sub class_to_table_plural { my($self) = shift; $self->singular_to_plural($self->class_to_table_singular(@_)); } sub table_to_class_plural { my($self, $table, $prefix) = @_; return $self->table_to_class($table, $prefix, 1); } sub table_to_class { my($self, $table, $prefix, $plural) = @_; $table = lc $table if ($self->force_lowercase); $table = $self->plural_to_singular($table) unless($plural); $table =~ s/_(.)/\U$1/g; $table =~ s/[^\w:]/_/g; return ($prefix || '') . ucfirst $table; } sub auto_manager_base_name { my($self, $table, $object_class) = @_; $table ||= $self->class_to_table_plural; $table = lc $table if($self->force_lowercase); return $self->tables_are_singular ? $self->singular_to_plural($table) : $table; } sub auto_manager_base_class { 'Rose::DB::Object::Manager' } sub auto_manager_class_name { my($self, $object_class) = @_; $object_class ||= $self->meta->class; return "${object_class}::Manager"; } sub auto_manager_method_name { my($self, $type, $base_name, $object_class) = @_; return undef; # rely on hard-coded defaults in Manager } sub class_prefix { my($self, $class) = @_; $class =~ /^((?:\w+::)*)/; return $1 || ''; } sub related_table_to_class { my($self, $table, $local_class, $plural) = @_; return $self->table_to_class($table, $self->class_prefix($local_class), $plural); } sub table_singular { my($self) = shift; my $table = $self->meta->table; if($self->tables_are_singular) { return $table; } return $self->plural_to_singular($table); } sub table_plural { my($self) = shift; my $table = $self->meta->table; if($self->tables_are_singular) { return $self->singular_to_plural($table); } return $table; } sub auto_table_name { my($self) = shift; if($self->tables_are_singular) { return $self->class_to_table_singular; } else { return $self->class_to_table_plural; } } sub auto_primary_key_column_names { my($self) = shift; my $meta = $self->meta; # 1. Column named "id" return [ 'id' ] if($meta->column('id')); # 2. Column named _id my $column = $self->class_to_table_singular . '_id'; return [ $column ] if($meta->column($column)); # 3. The first serial column in the column list, alphabetically foreach my $column (sort { lc $a->name cmp lc $b->name } $meta->columns) { return [ $column->name ] if($column->type =~ /^(?:big)?serial$/); } # 4. The first column if(my $column = $meta->first_column) { return [ $column->name ]; } return; } sub auto_column_method_name { my($self, $type, $column, $name, $object_class) = @_; return lc $name if ($self->force_lowercase); return undef; # rely on hard-coded defaults in Metadata } sub init_singular_to_plural_function { } sub init_plural_to_singular_function { } sub singular_to_plural { my($self, $word) = @_; if(my $code = $self->singular_to_plural_function) { return $code->($word); } if($word =~ /(?:x|[se]s)$/i) { return $word . 'es'; } else { $word =~ s/y$/ies/i; } return $word =~ /s$/i ? $word : ($word . 's'); } sub plural_to_singular { my($self, $word) = @_; if(my $code = $self->plural_to_singular_function) { return $code->($word); } $word =~ s/ies$/y/i; return $word if($word =~ s/ses$/s/i); return $word if($word =~ /[aeiouy]ss$/i); $word =~ s/s$//i; return $word; } sub method_name_conflicts { my($self, $name) = @_; return 1 if(Rose::DB::Object->can($name)); my $meta = $self->meta; foreach my $column ($meta->columns) { foreach my $type ($column->auto_method_types) { my $method = $column->method_name($type) || $meta->method_name_from_column_name($column->name, $type) || next; return 1 if($name eq $method); } } foreach my $foreign_key ($meta->foreign_keys) { foreach my $type ($foreign_key->auto_method_types) { my $method = $foreign_key->method_name($type) || $foreign_key->build_method_name_for_type($type) || next; return 1 if($name eq $method); } } foreach my $relationship ($meta->relationships) { foreach my $type ($relationship->auto_method_types) { my $method = $relationship->method_name($type) || $relationship->build_method_name_for_type($type) || next; return 1 if($name eq $method); } } return 0; } sub auto_column_sequence_name { my($self, $table, $column, $db) = @_; my $name = join('_', $table, $column, 'seq'); return uc $name if($db && $db->likes_uppercase_sequence_names); return lc $name if($db && $db->likes_lowercase_sequence_names); return $name; } sub auto_primary_key_column_sequence_name { shift->auto_column_sequence_name(@_) } sub auto_foreign_key_name { my($self, $f_class, $current_name, $key_columns, $used_names) = @_; if($self->force_lowercase) { $current_name = lc $current_name; $key_columns = { map { lc } %$key_columns }; } my $f_meta = $f_class->meta or return $current_name; my $name = $self->plural_to_singular($f_meta->table) || $current_name; if(keys %$key_columns == 1) { my($local_column, $foreign_column) = %$key_columns; # Try to lop off foreign column name. Example: # my_foreign_object_id -> my_foreign_object if($local_column =~ s/_$foreign_column$//i) { $name = $local_column; } else { $name = $self->plural_to_singular($f_meta->table) || $current_name; } } # Avoid method name conflicts if($self->method_name_conflicts($name) || $used_names->{$name}) { foreach my $s ('_obj', '_object') { # Try the name with a suffix appended unless($self->method_name_conflicts($name . $s) || $used_names->{$name . $s}) { return $name . $s; } } my $i = 1; # Give up and go with numbers... $i++ while($self->method_name_conflicts($name . $i) || $used_names->{$name . $i}); return $name . $i; } return $name; } sub auto_table_to_relationship_name_plural { my($self, $table) = @_; $table = lc $table if ($self->force_lowercase); return $self->tables_are_singular ? $self->singular_to_plural($table) : $table; } sub auto_class_to_relationship_name_plural { my($self, $class) = @_; return $self->class_to_table_plural($class); } sub auto_foreign_key_to_relationship_name_plural { my($self, $fk) = @_; my $name = $self->force_lowercase ? lc $fk->name : $fk->name; return $self->singular_to_plural($name); } sub auto_relationship_name_one_to_many { my($self, $table, $class) = @_; #return $self->auto_class_to_relationship_name_plural($class); my $name = $self->auto_table_to_relationship_name_plural($table); # Avoid method name conflicts if($self->method_name_conflicts($name)) { foreach my $s ('_objs', '_objects') { # Try the name with a suffix appended unless($self->method_name_conflicts($name . $s)) { return $name . $s; } } my $i = 1; # Give up and go with numbers... $i++ while($self->method_name_conflicts($name . $i)); return $name . $i; } return $name; } sub auto_relationship_name_many_to_many { my($self, $fk, $map_class) = @_; my $name = $self->auto_foreign_key_to_relationship_name_plural($fk); # Avoid method name conflicts if($self->method_name_conflicts($name)) { foreach my $s ('_objs', '_objects') { # Try the name with a suffix appended unless($self->method_name_conflicts($name . $s)) { return $name . $s; } } my $i = 1; # Give up and go with numbers... $i++ while($self->method_name_conflicts($name . $i)); return $name . $i; } return $name; } sub auto_relationship_name_one_to_one { my($self, $table, $class) = @_; $table = lc $table if ($self->force_lowercase); my $name = $self->plural_to_singular($table); # Avoid method name conflicts if($self->method_name_conflicts($name)) { foreach my $s ('_obj', '_object') { # Try the name with a suffix appended unless($self->method_name_conflicts($name . $s)) { return $name . $s; } } my $i = 1; # Give up and go with numbers... $i++ while($self->method_name_conflicts($name . $i)); return $name . $i; } return $name; } sub is_map_class { my($self, $class) = @_; return 0 unless(UNIVERSAL::isa($class, 'Rose::DB::Object')); my $is_map_table = $self->looks_like_map_table($class->meta->table); my $is_map_class = $self->looks_like_map_class($class); return 1 if($is_map_table && (!defined $is_map_class || $is_map_class)); return 0; } sub looks_like_map_class { my($self, $class) = @_; unless(UNIVERSAL::isa($class, 'Rose::DB::Object')) { return undef; } my $meta = $class->meta; my @fks = $meta->foreign_keys; return 1 if(@fks == 2); return 0 if(($meta->is_initialized || $meta->initialized_foreign_keys) && !$meta->has_deferred_foreign_keys); return undef; } sub looks_like_map_table { my($self, $table) = @_; if($table =~ m{^(?: (?:\w+_){2,}map # foo_bar_map | (?:\w+_)*\w+_(?:\w+_)*\w+s # foo_bars | (?:\w+_)*\w+s_(?:\w+_)*\w+s # foos_bars )$}xi) { return 1; } return 0; } sub auto_foreign_key { my($self, $name, $spec) = @_; $spec ||= {}; my $meta = $self->meta; unless($spec->{'class'}) { my $class = $meta->class; my $fk_class = $self->related_table_to_class($name, $class); LOAD: { # Try to load class no strict 'refs'; unless(UNIVERSAL::isa($fk_class, 'Rose::DB::Object')) { local $@; eval "require $fk_class"; return if($@ || !UNIVERSAL::isa($fk_class, 'Rose::DB::Object')); } } #return unless(UNIVERSAL::isa($fk_class, 'Rose::DB::Object')); $spec->{'class'} = $fk_class; } unless(defined $spec->{'key_columns'}) { my @fpk_columns = UNIVERSAL::isa($spec->{'class'}, 'Rose::DB::Object') ? $spec->{'class'}->meta->primary_key_column_names : (); # Defer population of key columns until the foreign class is initialized unless(@fpk_columns == 1) { # If the foreign class has more than one primary key column, give up return if(@fpk_columns); # If the foreign class is initialized and the foreign key spec still # has no key columns, then give up. if(UNIVERSAL::isa($spec->{'class'}, 'Rose::DB::Object') && $spec->{'class'}->meta->is_initialized) { return; } my %spec = %$spec; $meta->add_deferred_task( { class => $meta->class, method => "foreign_key:$name", code => sub { # Generate new foreign key, then grab the key columns from it my $new_fk = $self->auto_foreign_key($name, \%spec) or return; my $fk = $meta->foreign_key($name); my $key_cols = $new_fk->key_columns or return; $fk->key_columns($key_cols); }, check => sub { my $fk = $meta->foreign_key($name) or return 0; # If the foreign class is initialized and the foreign key still # has no key columns, then we should give up. if(UNIVERSAL::isa($fk->class, 'Rose::DB::Object') && $fk->class->meta->is_initialized) { Carp::croak "Missing key columns for foreign key named ", $fk->name, " in class ", $meta->class; } my $cols = $fk->key_columns or return 0; # Everything is okay if we have key columns return (ref($cols) && keys(%$cols) > 0) ? 1 : 0; } }); return Rose::DB::Object::Metadata::ForeignKey->new(name => $name, %$spec); } my $aliases = $meta->column_aliases; if($meta->column($name) && $aliases->{$name} && $aliases->{$name} ne $name) { $spec->{'key_columns'} = { $name => $fpk_columns[0] }; } elsif($meta->column("${name}_$fpk_columns[0]")) { $spec->{'key_columns'} = { "${name}_$fpk_columns[0]" => $fpk_columns[0] }; } else { return } } return Rose::DB::Object::Metadata::ForeignKey->new(name => $name, %$spec); } sub auto_relationship { my($self, $name, $rel_class, $spec) = @_; $spec ||= {}; my $meta = $self->meta; my $rel_type = $rel_class->type; unless($spec->{'class'}) { if($rel_type eq 'one to many') { my $class = $meta->class; # Get class suffix from relationship name my $table = $self->plural_to_singular($name); my $f_class = $self->related_table_to_class($table, $class); LOAD: { # Try to load class no strict 'refs'; unless(UNIVERSAL::isa($f_class, 'Rose::DB::Object')) { local $@; eval "require $f_class"; return if($@ || !UNIVERSAL::isa($f_class, 'Rose::DB::Object')); } } #return unless(UNIVERSAL::isa($f_class, 'Rose::DB::Object')); $spec->{'class'} = $f_class; } elsif($rel_type =~ /^(?:one|many) to one$/) { my $class = $meta->class; # Get class suffix from relationship name my $f_class = $self->related_table_to_class($name, $class); LOAD: { # Try to load class no strict 'refs'; unless(UNIVERSAL::isa($f_class, 'Rose::DB::Object')) { local $@; eval "require $f_class"; return if($@ || !UNIVERSAL::isa($f_class, 'Rose::DB::Object')); } } #return unless(UNIVERSAL::isa($f_class, 'Rose::DB::Object')); $spec->{'class'} = $f_class; } } # Make sure this class has its @ISA set up... unless(UNIVERSAL::isa($spec->{'class'}, 'Rose::DB::Object')) { # ...but allow many-to-many relationships to pass because they tend to # need more time before every piece of info is available. return unless($rel_type eq 'many to many'); } if($rel_type eq 'one to one') { return $self->auto_relationship_one_to_one($name, $rel_class, $spec); } elsif($rel_type eq 'many to one') { return $self->auto_relationship_many_to_one($name, $rel_class, $spec); } elsif($rel_type eq 'one to many') { return $self->auto_relationship_one_to_many($name, $rel_class, $spec); } elsif($rel_type eq 'many to many') { return $self->auto_relationship_many_to_many($name, $rel_class, $spec); } return; } sub auto_relationship_one_to_one { my($self, $name, $rel_class, $spec) = @_; $spec ||= {}; my $meta = $self->meta; unless(defined $spec->{'column_map'}) { my @fpk_columns = $spec->{'class'}->meta->primary_key_column_names; return unless(@fpk_columns == 1); my $aliases = $meta->column_aliases; if($meta->column($name) && $aliases->{$name} && $aliases->{$name} ne $name) { $spec->{'column_map'} = { $name => $fpk_columns[0] }; } elsif($meta->column("${name}_$fpk_columns[0]")) { $spec->{'column_map'} = { "${name}_$fpk_columns[0]" => $fpk_columns[0] }; } elsif($meta->column("${name}_id")) { $spec->{'column_map'} = { "${name}_id" => $fpk_columns[0] }; } else { return } } return $rel_class->new(name => $name, %$spec); } *auto_relationship_many_to_one = \&auto_relationship_one_to_one; sub auto_relationship_one_to_many { my($self, $name, $rel_class, $spec) = @_; $spec ||= {}; my $meta = $self->meta; my $l_col_name = $self->class_to_table_singular; unless(defined $spec->{'column_map'}) { my @pk_columns = $meta->primary_key_column_names; return unless(@pk_columns == 1); my @fpk_columns = $meta->primary_key_column_names; return unless(@fpk_columns == 1); my $f_meta = $spec->{'class'}->meta; my $aliases = $f_meta->column_aliases; if($f_meta->column($l_col_name)) { $spec->{'column_map'} = { $pk_columns[0] => $l_col_name }; } elsif($f_meta->column("${l_col_name}_$pk_columns[0]")) { $spec->{'column_map'} = { $pk_columns[0] => "${l_col_name}_$pk_columns[0]" }; } else { return } } return $rel_class->new(name => $name, %$spec); } sub auto_relationship_many_to_many { my($self, $name, $rel_class, $spec) = @_; $spec ||= {}; my $meta = $self->meta; unless($spec->{'map_class'}) { my $class = $meta->class; # Given: # Class: My::Object # Rel name: other_objects # Foreign class: My::OtherObject # # Consider map class names: # My::ObjectsOtherObjectsMap # My::ObjectOtherObjectMap # My::OtherObjectsObjectsMap # My::OtherObjectObjectMap # My::ObjectsOtherObjects # My::ObjectOtherObjects # My::OtherObjectsObjects # My::OtherObjectObjects # My::OtherObjectMap # My::OtherObjectsMap # My::ObjectMap # My::ObjectsMap my $prefix = $self->class_prefix($class); my @consider; my $f_class_suffix = $self->table_to_class($name); my $f_class_suffix_pl = $self->table_to_class_plural($name); $class =~ /(\w+)$/; my $class_suffix = $1; my $class_suffix_pl = $self->singular_to_plural($class_suffix); push(@consider, map { "${prefix}$_" } $class_suffix_pl . $f_class_suffix_pl . 'Map', $class_suffix . $f_class_suffix . 'Map', $f_class_suffix_pl . $class_suffix_pl . 'Map', $f_class_suffix . $class_suffix . 'Map', $class_suffix_pl . $f_class_suffix_pl, $class_suffix . $f_class_suffix_pl, $f_class_suffix_pl . $class_suffix_pl, $f_class_suffix . $class_suffix_pl, $f_class_suffix . 'Map', $f_class_suffix_pl . 'Map', $class_suffix . 'Map', $class_suffix_pl . 'Map'); my $map_class; CLASS: foreach my $class (@consider) { LOAD: { # Try to load class no strict 'refs'; if(UNIVERSAL::isa($class, 'Rose::DB::Object')) { $map_class = $class; last CLASS; } else { local $@; eval "require $class"; unless($@) { $map_class = $class; last CLASS if(UNIVERSAL::isa($class, 'Rose::DB::Object')); } } } } return unless($map_class && UNIVERSAL::isa($map_class, 'Rose::DB::Object')); $spec->{'map_class'} = $map_class; } return $rel_class->new(name => $name, %$spec); } 1; __END__ =head1 NAME Rose::DB::Object::ConventionManager - Provide missing metadata by convention. =head1 SYNOPSIS package My::Product; use base 'Rose::DB::Object'; __PACKAGE__->meta->setup(columns => [ ... ]); # No table is set above, but look at this: the # convention manager provided one for us. print __PACKAGE__->meta->table; # "products" ## ## See the EXAMPLE section below for a more complete demonstration. ## =head1 DESCRIPTION Each L-derived object has a L that it uses to fill in missing L. The convention manager encapsulates a set of rules (conventions) for generating various pieces of metadata in the absence of explicitly specified values: table names, column names, etc. Each L-derived class's convention manager object is stored in the L attribute of its L (L) object. L is the default convention manager class. The object method documentation below describes both the purpose of each convention manager method and the particular rules that L follows to fulfill that purpose. Subclasses must honor the purpose of each method, but are free to use any rules they choose. B When reading the descriptions of the rules used by each convention manager method below, remember that only values that are I will be set by the convention manager. Explicitly providing a value for a piece of metadata obviates the need for the convention manager to generate one. If insufficient information is available, or if the convention manager simply declines to fulfill a request, undef may be returned from any metadata-generating method. In the documentation, the adjectives "local" and "foreign" are used to distinguish between the things that belong to the convention manager's L and the class on "the other side" of the inter-table relationship, respectively. =head1 SUMMARY OF DEFAULT CONVENTIONS Although the object method documentation below includes all the information required to understand the default conventions, it's also quite spread out. What follows is a summary of the default conventions. Some details have necessarily been omitted or simplified for the sake of brevity, but this summary should give you a good starting point for further exploration. Here's a brief summary of the default conventions as implemented in L. =over 4 =item B Examples: C, C, C, C. =item B
Examples: C, C, C, C, C. (This convention can be overridden via the L method.) =item B Examples: C, C, C, C, C. =item B For example, the primary key column name in the C table might be C or C, but should B be C or C. =item B Examples: C, C, C. =item B Examples: C, C, C. These relationships may point to zero or one foreign object. The default method names generated from such relationships are based on the relationship names, so singular names make the most sense. =item B Examples: C, C, C. These relationships may point to more than one foreign object. The default method names generated from such relationships are based on the relationship names, so plural names make the most sense. =item B See the L, L, and L documentation for all the details. =back =head1 CONSTRUCTOR =over 4 =item B Constructs a new object based on PARAMS, where PARAMS are name/value pairs. Any object attribute is a valid parameter name. =back =head1 OBJECT METHODS =over 4 =item B Given a L column L, a L object or column name, a default method name, and a L-derived class name, return an appropriate method name. The default implementation simply returns undef, relying on the hard-coded default method-type-to-name mapping implemented in L's L method. =item B Given a L name and an optional reference to a hash SPEC of the type passed to L's L method, return an appropriately constructed L object. The foreign key's L is generated by calling L, passing NAME and the convention manager's L as arguments. An attempt is made is load the class. If this fails, the foreign key's L is not set. The foreign key's L are only set if both the "local" and "foreign" tables have single-column primary keys. The foreign class's primary key column name is used as the foreign column in the L map. If there is a local column with the same name as the foreign key name, and if that column is aliased (making way for the foreign key method to use that name), then that is used as the local column. If not, then the local column name is generated by joining the foreign key name and the foreign class's primary key column name with an underscore. If no column by that name exists, then the search is abandoned. Example: Given these pieces: Name Description Value --------- -------------------------------- ------- NAME Foreign key name vendor FCLASS Foreign class My::Vendor FPK Foreign primary key column name id Consider column maps in this order: Value Formula --------------------- ---------------------- { vendor => 'id' } { NAME => FPK } { vendor_id => 'id' } { _ => FPK } =item B Given the name of a foreign class, the current foreign key name (if any), a reference to a hash of L, and a reference to a hash whose keys are foreign key names already used in this class, return a L for the foreign key. If there is more than one pair of columns in KEY_COLUMNS, then the name is generated by calling L, passing the L name of the foreign class. The CURRENT_NAME is used if the call to L does not return a true value. If there is just one pair of columns in KEY_COLUMNS, and if the name of the local column ends with an underscore and the name of the referenced column, then that part of the column name is removed and the remaining string is used as the foreign key name. For example, given the following tables: CREATE TABLE categories ( id SERIAL PRIMARY KEY, ... ); CREATE TABLE products ( category_id INT REFERENCES categories (id), ... ); The foreign key name would be "category", which is the name of the referring column ("category_id") with an underscore and the name of the referenced column ("_id") removed from the end of it. If the foreign key has only one column, but it does not meet the criteria described above, then the name is generated by calling L, passing the L name of the foreign class. The CURRENT_NAME is used if the call to L does not return a true value. If the name selected using the above techniques is in the USED_NAMES hash, or is the same as that of an existing or potential method in the target class, then the suffixes "_obj" and "_object" are tried in that order. If neither of those suffixes resolves the situation, then ascending numeric suffixes starting with "1" are tried until a unique name is found. =item B Given a table name and the name of the L-derived class that fronts it, return a base name suitable for use as the value of the C parameter to L's L method. If no table is specified then the table name is derived from the current class name by calling L. If L is true, then TABLE is passed to the L method and the result is returned. Otherwise, TABLE is returned as-is. =item B Return the class that all manager classes will default to inheriting from. By default this will be L. =item B Given the name of a L-derived class, returns a class name for a L-derived class to manage such objects. The default implementation simply appends "::Manager" to the L-derived class name. =item B Given the specified L L, L, and L return an appropriate L method name. The default implementation simply returns undef, relying on the hard-coded default method-type-to-name mapping implemented in L's L method. =item B Return the name of a "many to many" relationship that fetches objects from the table pointed to by the L object FK by going through the class MAPCLASS. The default implementation passes the name of the table pointed to by FK through the L method in order to build the name. If the selected name is the name of an existing or potential method in the target class, then the suffixes "_objs" and "_objects" are tried in that order. If neither of those suffixes resolves the situation, then ascending numeric suffixes starting with "1" are tried until a unique name is found. =item B Return the name of a "one to many" relationship that fetches objects from the specified TABLE and CLASS. If L is true, then TABLE is passed to the L method and the result is used as the name. Otherwise, TABLE is used as-is. If the selected name is the name of an existing or potential method in the target class, then the suffixes "_objs" and "_objects" are tried in that order. If neither of those suffixes resolves the situation, then ascending numeric suffixes starting with "1" are tried until a unique name is found. =item B Return the name of a "one to one" relationship that fetches an object from the specified TABLE and CLASS. The default implementation returns a singular version of the table name. If the selected name is the name of an existing or potential method in the target class, then the suffixes "obj_" and "_object" are tried in that order. If neither of those suffixes resolves the situation, then ascending numeric suffixes starting with "1" are tried until a unique name is found. =item B Returns a reference to an array of primary key column names. If a column named "id" exists, it is selected as the sole primary key column name. If not, the column name generated by joining the return value of L with "_id" is considered. If no column with that name exists, then the first column (sorted alphabetically) whose L is "serial" is selected. If all of the above fails, then the L is selected as the primary key column (assuming one exists). Examples: My::A->meta->columns(qw(a a_id id)); print My::A->meta->primary_key_columns; # "id" My::B->meta->columns(qw(b b_id foo)); print My::B->meta->primary_key_columns; # "a_id" My::D->meta->columns ( cnt => { type => 'int' }, dub => { type => 'serial' }, foo => { type => 'serial'}, a_id => { type => 'int' } ) print My::D->meta->primary_key_columns; # "dub" My::C->meta->columns(qw(foo bar baz)); print My::C->meta->primary_key_columns; # "foo" =item B Given a L name, a L-derived class name, and an optional reference to a hash SPEC of the type passed to L's L method, return an appropriately constructed L-derived object. If the relationship's L is "one to one" or "many to one", then the relationship's L is generated by calling L, passing NAME and the convention manager's L as arguments. An attempt is made is load the class. If this fails, the relationship's L is not set. The L for "one to one" and "many to one" relationships is generated using the same rules used to generate L in the L method. If the relationship's L is "one to many" then the relationship's L is generated by calling L on NAME, then passing that value along with the convention manager's L to the L method. An attempt is made is load the class. If this fails, the relationship's L is not set. The L for a "one to many" relationship is only set if both the "local" and "foreign" tables have single-column primary keys. The following ordered list of combinations is considered. Given: Local class: My::Product Foreign class: My::Price Relationship: prices Generate these pieces: Name Description Value --------- --------------------------------- ------- LTABLE_S Local class_to_table_singular() product LPK Local primary key column name id FPK Foreign primary key column name id Consider column maps in this order: Value Formula ---------------------- -------------------------- { id => 'product' } { LPK => LTABLE_S } { id => 'product_id' } { LPK => _ } The first value whose foreign column actually exists in the foreign table is chosen. If the relationship's L is "many to many" then the relationship's L is chosen from a list of possibilities. This list is generated by constructing singular and plural versions of the local and foreign class names (sans prefixes) and then joining them in various ways, all re-prefixed by the L of the convention manager's L. Example: Given: Local class: My::Product Foreign class: My::Color Relationship: colors Generate these pieces: Name Description Value --------- --------------------------------- ------- PREFIX Local class prefix My:: LCLASS_S Unprefixed local class, singular Product LCLASS_P Unprefixed local class, plural Products FCLASS_S Unprefixed foreign class, singular Color FCLASS_P Unprefixed foreign class, plural Colors Consider map class names in this order: Value Formula --------------- --------------------- My::ProductsColorsMap Map My::ProductColorMap Map My::ColorsProductsMap Map My::ColorProductMap Map My::ProductsColors My::ProductColors My::ColorsProducts My::ColorProducts My::ColorMap Map My::ColorsMap Map My::ProductMap Map My::ProductsMap Map The first class found that inherits from L and is loaded successfully will be chosen as the relationship's L. =item B Returns a table name for the convention manager's L. Class names are singular and table names are plural. To build the table name, the L is removed from the L, transitions from lowercase letters or digits to uppercase letters have underscores inserted, and the whole thing is converted to lowercase. Examples: Class Table ----------- -------- Product products My::Product products My::BigBox big_boxes My5HatPig my5_hat_pig =item B Get or set the L-derived class that this convention manager belongs to. =item B Given a class name, return the prefix, if any, before the last component of the namespace, including the final "::". If there is no prefix, an empty string is returned. Examples: Class Prefix ----------- -------------- Product My::Product My:: A::B::C::D A::B::C:: =item B Given a class name, or the convention manager's L if omitted, return a plural version of the corresponding table name. To do this, the output of the L method is passed to a call to the L method. (The CLASS argument, if any, is passed to the call to L.) Examples: Class Table ----------- -------- Product products My::Product products My::Box boxes =item B Given a class name, or the convention manager's L if omitted, return a singular version of the corresponding table name. Examples: Class Table ----------- -------- Product product My::Product product My::Box box =item B Get or set a boolean value that indicates whether or not L entity names should be forced to lowercase even when the related entity is uppercase or mixed case. ("Metadata entities" are thing like L, L, and L.) The default value is false. =item B Returns true if CLASS is a L used as part of a L relationship, false if it does not. The default implementations returns true if CLASS is derived from L and its L name looks like a map table name according to the L method and the L method returns either true or undef. Override this method to control which classes are considered map classes. Note that it may be called several times on the same class at various stages of that class's construction. =item B Given the class name CLASS, returns true if it looks like the name of a L used as part of a L relationship, false (but defined) if it does not, and undef if it's unsure. The default implementation returns true if CLASS is derived from L and has exactly two foreign keys. It returns false (but defined) if CLASS is derived from L and has been L (or if the foreign keys have been L) and the CLASS has no deferred foreign keys. It returns undef otherwise. =item B Returns true if TABLE looks like the name of a mapping table used as part of a L relationship, false (but defined) if it does not, and undef if it's unsure. The default implementation returns true if TABLE is in one of these forms: Regex Examples ----------------------- ----------------------------- (\w+_){2,}map pig_toe_map, pig_skin_toe_map (\w+_)*\w+_(\w+_)*\w+s pig_toes, pig_skin_toe_jams (\w+_)*\w+s_(\w+_)*\w+s pigs_toes, pig_skins_toe_jams It returns false otherwise. =item B Get or set the L object associated with the class that this convention manager belongs to. =item B Returns the singular version of STRING. If a L is defined, then this method simply passes STRING to that function. Otherwise, the following rules are applied, case-insensitively. * If STRING ends in "ies", then the "ies" is replaced with "y". * If STRING ends in "ses" then the "ses" is replaced with "s". * If STRING matches C, it is returned unmodified. For all other cases, the letter "s" is removed from the end of STRING and the result is returned. =item B Get or set a reference to the function used to convert strings to singular. The function should take a single string as an argument and return a singular version of the string. This function is undefined by default. =item B Given a table name and a local class name, return the name of the related class that fronts the table. To do this, L is called with TABLE and the L of LOCAL_CLASS passed as arguments. Examples: Table Local Class Related Class ----------- ------------ ---------------- prices My::Product My::Price big_hats A::B::FooBar A::B::BigHat a1_steaks Meat A1Steak =item B Returns the plural version of STRING. If a L is defined, then this method simply passes STRING to that function. Otherwise, the following rules are applied, case-insensitively, to form the plural. * If STRING ends in "x", "ss", or "es", then "es" is appended. * If STRING ends in "y" then the "y" is replaced with "ies". * If STRING ends in "s" then it is returned as-is. * Otherwise, "s" is appended. =item B Get or set a reference to the function used to convert strings to plural. The function should take a single string as an argument and return a plural version of the string. This function is undefined by default. =item B Let TABLE be the return value of the L method called on the L attribute of this object. If L is true, then TABLE is returned as-is. Otherwise, TABLE is passed to the L method and the result is returned. Otherwise, TABLE is returned as-is. =item B Let TABLE be the return value of the L method called on the L attribute of this object. If L is true, then TABLE is passed to the L method and the result is returned. Otherwise, TABLE is returned as-is. =item B Given a table name and an optional class prefix, return the corresponding class name. The prefix will be appended to the class name, if present. The prefix should end in "::". To do this, any letter that follows an underscore ("_") in the table name is replaced with an uppercase version of itself, and the underscore is removed. Examples: Table Prefix Class ----------- ------ ----------- products My:: My::Product products Product big_hats My:: My::BigHat my5_hat_pig My5HatPig =item B Get or set a boolean value that indicates whether or not table names are expected to be singular. The default value is false, meaning that table names are expected to be plural. =back =head1 PROTECTED API These methods are not part of the public interface, but are supported for use by subclasses. Put another way, given an unknown object that "isa" L, there should be no expectation that the following methods exist. But subclasses, which know the exact class from which they inherit, are free to use these methods in order to implement the public API described above. =over 4 =item B Override this method and return a reference to a function that takes a single string as an argument and returns a singular version of that string. =item B Override this method and return a reference to a function that takes a single string as an argument and returns a plural version of that string. =back =head1 TIPS AND TRICKS Much of the richness of a convention manager relies upon the quality of the L and L methods. The default implementations are primitive at best. For example, L will not correctly form the plural of the word "alumnus". One easy way to improve this is by setting a custom L. Here's an example using the handy L module: package My::Product; ... use Lingua::EN::Inflect; $cm = __PACKAGE__->meta->convention_manager; $cm->singular_to_plural_function(\&Lingua::EN::Inflect::PL); print $cm->singular_to_plural('person'); # "people" But that's a bit of a pain to do in every single class. An easier way to do it for all of your classes is to make a new L subclass that overrides the L method, then make a L-derived base class that uses your new metadata class. Example: package My::DB::Metadata; use Rose::DB::Object::Metadata; our @ISA = qw(Rose::DB::Object::Metadata); use Lingua::EN::Inflect; sub init_convention_manager { my $self = shift; # Let the base class make ths convention manager object my $cm = $self->SUPER::init_convention_manager(@_); # Set the new singular-to-plural function $cm->singular_to_plural_function(\&Lingua::EN::Inflect::PL); # Return the modified convention manager return $cm; } ... package My::DB::Object; use My::DB::Metadata; use Rose::DB::Object; our @ISA = qw(Rose::DB::Object); sub meta_class { 'My::DB::Metadata' } ... package My::Person; use My::DB::Object; our @ISA = qw(My::DB::Object); # The big pay-off: smart plurals! print __PACKAGE__->meta->table; # "people" You might wonder why I don't use L in L to save you this effort. The answer is that the L module adds almost a megabyte of memory overhead on my system. I'd rather not incur that overhead just for the sake of being more clever about naming conventions. Furthermore, as primitive as the default plural-forming is, at least it's deterministic. Guessing what L will return is not always easy, and the results can change depending on which version L you have installed. =head1 EXAMPLE Here's a complete example of nearly all of the major features of L. Let's start with the database schema. (This example uses PostgreSQL, but any L with native foreign key support will work.) CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) ); CREATE TABLE colors ( code CHAR(3) NOT NULL PRIMARY KEY, name VARCHAR(255) ); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255), vendor_id INT NOT NULL REFERENCES vendors (id) ); CREATE TABLE prices ( price_id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL ); CREATE TABLE product_colors ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), color_code CHAR(3) NOT NULL REFERENCES colors (code) ); Now the classes: # Rose::DB subclass to handle the db connection package My::DB; use base 'Rose::DB'; My::DB->register_db ( type => 'default', domain => 'default', driver => 'Pg', database => 'test', username => 'postgres', ); ... # Common Rose::DB::Object-derived base class for the other objects package My::Object; use My::DB; use base 'Rose::DB::Object'; sub init_db { My::DB->new } ... package My::Price; use base 'My::Object'; __PACKAGE__->meta->setup ( columns => [ price_id => { type => 'serial', not_null => 1 }, product_id => { type => 'int' }, region => { type => 'char', length => 2, default => 'US' }, price => { type => 'decimal', precision => 10, scale => 2 }, ], foreign_keys => [ 'product' ], ); ... package My::Vendor; use base 'My::Object'; __PACKAGE__->meta->setup ( columns => [ id => { type => 'serial', not_null => 1 }, name => { type => 'varchar', length => 255 }, ], ); ... package My::Color; use base 'My::Object'; __PACKAGE__->meta->setup ( columns => [ code => { type => 'char', length => 3, not_null => 1 }, name => { type => 'varchar', length => 255 }, ], ); ... package My::Product; use base 'My::Object'; __PACKAGE__->meta->setup ( columns => [ id => { type => 'serial', not_null => 1 }, name => { type => 'varchar', length => 255 }, vendor_id => { type => 'int' }, ], foreign_keys => [ 'vendor' ], relationships => [ prices => { type => 'one to many' }, colors => { type => 'many to many' }, ], ); ... package My::ProductColors; use base 'My::Object'; __PACKAGE__->meta->setup ( columns => [ qw(id product_id color_code) ], foreign_keys => [ 'product', 'color' ], ); Let's add some data: INSERT INTO vendors (id, name) VALUES (1, 'V1'); INSERT INTO vendors (id, name) VALUES (2, 'V2'); INSERT INTO products (id, name, vendor_id) VALUES (1, 'A', 1); INSERT INTO products (id, name, vendor_id) VALUES (2, 'B', 2); INSERT INTO products (id, name, vendor_id) VALUES (3, 'C', 1); INSERT INTO prices (product_id, region, price) VALUES (1, 'US', 1.23); INSERT INTO prices (product_id, region, price) VALUES (1, 'DE', 4.56); INSERT INTO prices (product_id, region, price) VALUES (2, 'US', 5.55); INSERT INTO prices (product_id, region, price) VALUES (3, 'US', 5.78); INSERT INTO prices (product_id, region, price) VALUES (3, 'US', 9.99); INSERT INTO colors (code, name) VALUES ('CC1', 'red'); INSERT INTO colors (code, name) VALUES ('CC2', 'green'); INSERT INTO colors (code, name) VALUES ('CC3', 'blue'); INSERT INTO colors (code, name) VALUES ('CC4', 'pink'); INSERT INTO product_colors (product_id, color_code) VALUES (1, 'CC1'); INSERT INTO product_colors (product_id, color_code) VALUES (1, 'CC2'); INSERT INTO product_colors (product_id, color_code) VALUES (2, 'CC4'); INSERT INTO product_colors (product_id, color_code) VALUES (3, 'CC2'); INSERT INTO product_colors (product_id, color_code) VALUES (3, 'CC3'); (Be aware that not all databases are smart enough to track explicitly setting serial column values as shown in the INSERT statements above. Subsequent auto-generated serial values may conflict with the explicitly set serial column values already in the table. Values are set explicitly here to make the examples easier to follow. In "real" code, you should let the serial columns populate automatically.) Finally, the classes in action: $p = My::Product->new(id => 1)->load; print $p->vendor->name, "\n"; # "V1" # "US: 1.23, DE: 4.56" print join(', ', map { $_->region .': '. $_->price } $p->prices), "\n"; # "red, green" print join(', ', map { $_->name } $p->colors), "\n"; =head1 AUTO-INIT EXAMPLE Using L's L feature, the Perl code can be reduced to an absurd degree. Given the same database schema and data shown in the L above, consider the following classes: package My::Auto::Color; use base 'My::Object'; __PACKAGE__->meta->auto_initialize; ... package My::Auto::Price; use base 'My::Object'; __PACKAGE__->meta->auto_initialize; ... package My::Auto::ProductColors; use base 'My::Object'; __PACKAGE__->meta->auto_initialize; ... package My::Auto::Vendor; use base 'My::Object'; __PACKAGE__->meta->auto_initialize; ... package My::Auto::Product; use base 'My::Object'; __PACKAGE__->meta->auto_initialize; Not a single table, column, foreign key, or relationship is specified, yet everything still works: $p = My::Auto::Product->new(id => 1)->load; print $p->vendor->name, "\n"; # "V1" # "US: 1.23, DE: 4.56" print join(', ', map { $_->region .': '. $_->price } $p->prices), "\n"; # "red, green" print join(', ', map { $_->name } $p->colors), "\n"; More precisely, everything still works I that you load all the of the related modules. For example, if you load C but don't load C (either from within the C class or in your program itself), then the C will not have a C method (since your program will have no knowledge of the C class). Use the L if you want to set up a bunch of related classes automatically without worrying about this kind of thing. Anyway, I don't recommend this kind of extreme approach, but it is an effective demonstration of the power of the convention manager. =head1 AUTHOR John C. Siracusa (siracusa@gmail.com) =head1 LICENSE Copyright (c) 2010 by John C. Siracusa. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Rose-DB-Object-0.810/lib/Rose/DB/Object/Exception.pm000755 000765 000120 00000000746 11113677033 021665 0ustar00johnadmin000000 000000 package Rose::DB::Object::Exception; use strict; use Rose::Object; our @ISA = qw(Rose::Object); our $VERSION = '0.01'; use overload ( '""' => sub { shift->message }, fallback => 1, ); use Rose::Object::MakeMethods::Generic ( scalar => [ 'message', 'code', ], ); sub init { my($self) = shift; @_ = (message => @_) if(@_ == 1); $self->SUPER::init(@_); } package Rose::DB::Object::Exception::ClassNotReady; our @ISA = qw(Rose::DB::Object::Exception); 1; Rose-DB-Object-0.810/lib/Rose/DB/Object/Helpers.pm000755 000765 000120 00000143531 12235452534 021334 0ustar00johnadmin000000 000000 package Rose::DB::Object::Helpers; use strict; use Rose::DB::Object::Constants qw(:all); use Rose::Object::MixIn; our @ISA = qw(Rose::Object::MixIn); require Rose::DB::Object::Util; use Carp; our $VERSION = '0.784'; __PACKAGE__->export_tags ( all => [ qw(clone clone_and_reset load_or_insert load_or_save insert_or_update insert_or_update_on_duplicate_key load_speculative column_value_pairs column_accessor_value_pairs column_mutator_value_pairs column_values_as_yaml column_values_as_json traverse_depth_first as_tree init_with_tree new_from_tree init_with_deflated_tree new_from_deflated_tree as_yaml new_from_yaml init_with_yaml as_json new_from_json init_with_json init_with_column_value_pairs has_loaded_related strip forget_related dirty_columns) ], # This exists for the benefit of the test suite all_noprereq => [ qw(clone clone_and_reset load_or_insert load_or_save insert_or_update insert_or_update_on_duplicate_key load_speculative column_value_pairs column_accessor_value_pairs column_mutator_value_pairs traverse_depth_first as_tree init_with_tree new_from_tree init_with_deflated_tree new_from_deflated_tree init_with_column_value_pairs has_loaded_related strip forget_related dirty_columns) ], ); # # Class data # use Rose::Class::MakeMethods::Generic ( inheritable_scalar => [ '_json_object' ], ); # # Class methods # sub json_encoder { my($class) = shift; my $json = $class->_json_object; unless(defined $json) { $json = $class->init_json_encoder; } return $json; } sub init_json_encoder { require JSON; croak "JSON version 2.00 or later is required. You have $JSON::VERSION" unless($JSON::VERSION >= 2.00); return JSON->new->utf8->space_after; } *json_decoder = \&json_encoder; # # Object methods # sub load_speculative { shift->load(@_, speculative => 1) } sub load_or_insert { my($self) = shift; my($ret, @ret, $loaded, $error); TRY: { local $@; # Ignore any errors due to missing primary/unique keys $loaded = eval { if(wantarray) { @ret = $self->load(@_, speculative => 1); return $ret[0] if($ret[0]); # return from eval } else { $ret = $self->load(@_, speculative => 1); return $ret if($ret); # return from eval } return 0; # return from eval }; $error = $@; } if($error) { # ...but re-throw all other errors unless(UNIVERSAL::isa($error, 'Rose::DB::Object::Exception') && $error->code == EXCEPTION_CODE_NO_KEY) { $self->meta->handle_error($self); return 0; } } return wantarray ? @ret : $ret if($loaded); return $self->insert; } sub load_or_save { my($self) = shift; my($ret, @ret, $loaded, $error); TRY: { local $@; # Ignore any errors due to missing primary/unique keys $loaded = eval { if(wantarray) { @ret = $self->load(@_, speculative => 1); return $ret[0] if($ret[0]); # return from eval } else { $ret = $self->load(@_, speculative => 1); return $ret if($ret); # return from eval } return 0; # return from eval }; $error = $@; } if($error) { # ...but re-throw all other errors unless(UNIVERSAL::isa($error, 'Rose::DB::Object::Exception') && $error->code == EXCEPTION_CODE_NO_KEY) { $self->meta->handle_error($self); return 0; } } return wantarray ? @ret : $ret if($loaded); return $self->save; } sub insert_or_update { my($self) = shift; # Initially trust the metadata if($self->{STATE_IN_DB()}) { local $@; eval { $self->save(@_, update => 1) }; return $self || 1 unless($@); } my $meta = $self->meta; # This is more "correct" #my $clone = clone($self); # ...but this is a lot faster my $clone = bless { %$self }, ref($self); my($loaded, $error); TRY: { local $@; # Ignore any errors due to missing primary/unique keys eval { $loaded = $clone->load(speculative => 1) }; $error = $@; } if($error) { # ...but re-throw all other errors unless(UNIVERSAL::isa($error, 'Rose::DB::Object::Exception') && $error->code == EXCEPTION_CODE_NO_KEY) { $meta->handle_error($self); return 0; } } if($loaded) { # The long way... my %pk; @pk{$meta->primary_key_column_mutator_names} = map { $clone->$_() } $meta->primary_key_column_accessor_names; $self->init(%pk); # The short (but dirty) way #my @pk_keys = $meta->primary_key_column_db_value_hash_keys; #@$self{@pk_keys} = @$clone{@pk_keys}; return $self->save(@_, update => 1); } return $self->save(@_, insert => 1) } sub insert_or_update_on_duplicate_key { my($self) = shift; unless($self->db->supports_on_duplicate_key_update) { return insert_or_update($self, @_); } return $self->save(@_, insert => 1, on_duplicate_key_update => 1); } __PACKAGE__->pre_import_hook(column_values_as_yaml => sub { require YAML::Syck }); sub column_values_as_yaml { local $_[0]->{STATE_SAVING()} = 1; YAML::Syck::Dump(scalar Rose::DB::Object::Helpers::column_value_pairs(shift)) } __PACKAGE__->pre_import_hook(column_values_as_json => sub { require JSON }); sub column_values_as_json { local $_[0]->{STATE_SAVING()} = 1; __PACKAGE__->json_encoder->encode(scalar Rose::DB::Object::Helpers::column_value_pairs(shift)) } sub init_with_column_value_pairs { my($self) = shift; my $hash = @_ == 1 ? shift : { @_ }; my $meta = $self->meta; local $self->{STATE_LOADING()} = 1; while(my($name, $value) = each(%$hash)) { next unless(length $name); my $method = $meta->column($name)->mutator_method_name; $self->$method($value); } return $self; } sub column_value_pairs { my($self) = shift; my %pairs; my $methods = $self->meta->column_accessor_method_names_hash; while(my($column, $method) = each(%$methods)) { $pairs{$column} = $self->$method(); } return wantarray ? %pairs : \%pairs; } sub key_column_value_pairs { my($self) = shift; my %pairs; my $methods = $self->meta->key_column_accessor_method_names_hash; while(my($column, $method) = each(%$methods)) { $pairs{$column} = $self->$method(); } return wantarray ? %pairs : \%pairs; } sub column_accessor_value_pairs { my($self) = shift; my %pairs; foreach my $method ($self->meta->column_accessor_method_names) { $pairs{$method} = $self->$method(); } return wantarray ? %pairs : \%pairs; } sub column_mutator_value_pairs { my($self) = shift; my %pairs; foreach my $column ($self->meta->columns) { my $method = $column->accessor_method_name; $pairs{$column->mutator_method_name} = $self->$method(); } return wantarray ? %pairs : \%pairs; } sub clone { my($self) = shift; my $class = ref $self; local $self->{STATE_CLONING()} = 1; my @mutators = $self->meta->column_mutator_method_names; my $mutator; return $class->new(map { (defined($mutator = shift(@mutators)) && defined $_) ? ($mutator => $self->$_()) : () } $self->meta->column_accessor_method_names); } sub clone_and_reset { my($self) = shift; my $class = ref $self; local $self->{STATE_CLONING()} = 1; my @mutators = $self->meta->column_mutator_method_names; my $mutator; my $clone = $class->new(map { (defined($mutator = shift(@mutators)) && defined $_) ? ($mutator => $self->$_()) : () } $self->meta->column_accessor_method_names); my $meta = $class->meta; no strict 'refs'; # Blank all primary and unique key columns foreach my $method ($meta->primary_key_column_mutator_names) { $clone->$method(undef); } foreach my $uk ($meta->unique_keys) { foreach my $column ($uk->columns) { my $method = $meta->column_mutator_method_name($column); $clone->$method(undef); } } # Also copy db object, if any if(my $db = $self->{'db'}) { #$self->{FLAG_DB_IS_PRIVATE()} = 0; $clone->db($db); } return $clone; } sub has_loaded_related { my($self) = shift; my $rel; # really a relationship or fk my $meta = $self->meta; if(@_ == 1) { my $name = shift; if($rel = $meta->foreign_key($name)) { return $rel->object_has_foreign_object($self) ? 1 : 0; } elsif($rel = $meta->relationship($name)) { return $rel->object_has_related_objects($self) ? 1 : 0; } else { croak "No foreign key or relationship named '$name' found in ", $meta->class; } } else { my %args = @_; my $name; if($name = $args{'foreign_key'}) { $rel = $meta->foreign_key($name) or croak "No foreign key named '$name' found in ", $meta->class; return $rel->object_has_foreign_object($self) ? 1 : 0; } elsif($name = $args{'relationship'}) { $rel = $meta->relationship($name) or croak "No relationship named '$name' found in ", $meta->class; return $rel->object_has_related_objects($self) ? 1 : 0; } else { croak "Missing foreign key or relationship name argument"; } } } sub forget_related { my($self) = shift; my $rel; # really a relationship or fk my $meta = $self->meta; if(@_ == 1) { my $name = shift; if($rel = $meta->foreign_key($name)) { return $rel->forget_foreign_object($self); } elsif($rel = $meta->relationship($name)) { return $rel->forget_related_objects($self); } else { croak "No foreign key or relationship named '$name' found in ", $meta->class; } } else { my %args = @_; my $name; if($name = $args{'foreign_key'}) { $rel = $meta->foreign_key($name) or croak "No foreign key named '$name' found in ", $meta->class; return $rel->forget_foreign_object($self); } elsif($name = $args{'relationship'}) { $rel = $meta->relationship($name) or croak "No relationship named '$name' found in ", $meta->class; return $rel->forget_related_objects($self); } else { croak "Missing foreign key or relationship name argument"; } } } sub strip { my($self) = shift; my %args = @_; my %leave = map { $_ => 1 } (ref $args{'leave'} ? @{$args{'leave'}} : ($args{'leave'} || '')); my $meta = $self->meta; if($leave{'relationships'} || $leave{'related_objects'}) { foreach my $rel ($meta->relationships) { if(my $objs = $rel->object_has_related_objects($self)) { foreach my $obj (@$objs) { Rose::DB::Object::Helpers::strip($obj, @_); } } } } else { foreach my $rel ($meta->relationships) { delete $self->{$rel->name}; } } if($leave{'foreign_keys'} || $leave{'related_objects'}) { foreach my $rel ($meta->foreign_keys) { if(my $obj = $rel->object_has_foreign_object($self)) { Rose::DB::Object::Helpers::strip($obj, @_); } } } else { foreach my $fk ($meta->foreign_keys) { delete $self->{$fk->name}; } } if($leave{'db'}) { $self->{'db'}->dbh(undef) if($self->{'db'}); } else { delete $self->{'db'}; } # Strip "on-save" code references: destructive! unless($args{'strip_on_save_ok'}) { if(__contains_code_ref($self->{ON_SAVE_ATTR_NAME()})) { croak qq(Refusing to strip "on-save" actions from ), ref($self), qq( object without strip_on_save_ok parameter); } } delete $self->{ON_SAVE_ATTR_NAME()}; # Reference to metadata object will be regenerated as needed delete $self->{META_ATTR_NAME()}; return $self; } sub __contains_code_ref { my($hash_ref) = shift; foreach my $key (keys %$hash_ref) { return 1 if(ref $hash_ref->{$key} eq 'CODE'); if(ref $hash_ref->{$key} eq 'HASH') { return 1 if(__contains_code_ref($hash_ref->{$key})); } else { Carp::confess "Unexpected reference encountered: $hash_ref->{$key}"; } } } # XXX: A value that is unlikely to exist in a primary key column value use constant PK_JOIN => "\0\2,\3\0"; sub primary_key_as_string { my($self, $joiner) = @_; return join($joiner || PK_JOIN, grep { defined } map { $self->$_() } $self->meta->primary_key_column_accessor_names); } use constant DEFAULT_MAX_DEPTH => 100; sub traverse_depth_first { my($self) = shift; my($context, $handlers, $exclude, $prune, $max_depth); my $visited = {}; my $force_load = 0; if(@_ == 1) { $handlers->{'object'} = shift; } else { my %args = @_; $handlers = $args{'handlers'} || {}; $force_load = $args{'force_load'} || 0; $context = $args{'context'}; $exclude = $args{'exclude'} || 0; $prune = $args{'prune'}; $max_depth = exists $args{'max_depth'} ? $args{'max_depth'} : DEFAULT_MAX_DEPTH; $visited = undef if($args{'allow_loops'}); } _traverse_depth_first($self, $context ||= {}, $handlers, $exclude, $prune, 0, $max_depth, undef, undef, $visited, $force_load); return $context; } require Rose::DB::Object::Util; use constant OK => 1; use constant LOOP_AVOIDED => -1; use constant HIT_MAX_DEPTH => -2; use constant FILTERED_OUT => -3; sub _traverse_depth_first { my($self, $context, $handlers, $exclude, $prune, $depth, $max_depth, $parent, $rel_meta, $visited, $force_load) = @_; if($visited && $visited->{ref($self),Rose::DB::Object::Helpers::primary_key_as_string($self)}++) { return LOOP_AVOIDED; } if($handlers->{'object'}) { if($exclude && $exclude->($self, $parent, $rel_meta)) { return FILTERED_OUT; } if($force_load && !Rose::DB::Object::Util::is_in_db($self)) { $self->load(speculative => 1); } $context = $handlers->{'object'}->($self, $context, $parent, $rel_meta, $depth); } if(defined $max_depth && $depth == $max_depth) { return HIT_MAX_DEPTH; } REL: foreach my $rel ($self->meta->relationships) { next if($prune && $prune->($rel, $self, $depth)); my $objs = $rel->object_has_related_objects($self); # XXX: Call above returns 0 if the collection is an empty array ref # XXX: and undef if it's not even a reference (e.g., undef). This # XXX: distinguishes between a collection that has been loaded and # XXX: found to have zero items, and one that has never been loaded. # XXX: To "un-hack" this, we'd need true tracking of load/store # XXX: actions to related collections. Or we could just omit the # XXX: empty collections from the traversal. $objs = [] if(defined $objs && !ref $objs); if($force_load || $objs) { unless($objs) { my $method = $rel->method_name('get_set_on_save') || $rel->method_name('get_set_now') || $rel->method_name('get_set') || next REL; $objs = $self->$method() || next REL; $objs = [ $objs ] unless(ref $objs eq 'ARRAY'); } my $c = $handlers->{'relationship'} ? $handlers->{'relationship'}->($self, $context, $rel) : $context; OBJ: foreach my $obj (@$objs) { next OBJ if($exclude && $exclude->($obj, $self, $rel)); my $ret = _traverse_depth_first($obj, $c, $handlers, $exclude, $prune, $depth + 1, $max_depth, $self, $rel, $visited, $force_load); if($ret == LOOP_AVOIDED && $handlers->{'loop_avoided'}) { $handlers->{'loop_avoided'}->($obj, $c, $self, $context, $rel) && last OBJ; } } } } return OK; } sub as_tree { my($self) = shift; my %args = @_; my $deflate = exists $args{'deflate'} ? $args{'deflate'} : 1; my $persistent_columns_only = exists $args{'persistent_columns_only'} ? $args{'persistent_columns_only'} : 0; my %tree; Rose::DB::Object::Helpers::traverse_depth_first($self, context => \%tree, handlers => { object => sub { my($self, $context, $parent, $relationship, $depth) = @_; local $self->{STATE_SAVING()} = 1 if($deflate); my $cols = Rose::DB::Object::Helpers::column_value_pairs($self); unless($persistent_columns_only) { # XXX: Inlined version of what would be nonpersistent_column_value_pairs() my $methods = $self->meta->nonpersistent_column_accessor_method_names_hash; while(my($column, $method) = each(%$methods)) { $cols->{$column} = $self->$method(); } } if(ref $context eq 'ARRAY') { push(@$context, $cols); return $cols; } else { @$context{keys %$cols} = values %$cols; return $context; } }, relationship => sub { my($self, $context, $relationship) = @_; my $name = $relationship->name; # Croak on name conflicts with columns if($self->meta->column($name)) { croak "$self: relationship '", $relationship->name, "' conflicts with column of the same name"; } if($relationship->is_singular) { return $context->{$name} = {}; } return $context->{$name} = []; }, loop_avoided => sub { my($object, $context, $parent_object, $parent_context, $relationship) = @_; # If any item can't be included due to loops, wipe entire collection and bail delete $parent_context->{$relationship->name}; return 1; # true return means stop processing items in this collection }, }, @_); return \%tree; } # XXX: This version requires all relationship and column mutators to have # XXX: the same names as the relationships and columns themselves. # sub init_with_tree { shift->init(@_) } # XXX: This version requires all relationship mutators to have the same # XXX: names as the relationships themselves. # sub init_with_tree # { # my($self) = shift; # # my $meta = $self->meta; # # while(my($name, $value) = each(%{@_ == 1 ? $_[0] : {@_}})) # { # next unless(length $name); # my $method; # # if(my $column = $meta->column($name)) # { # $method = $column->mutator_method_name; # $self->$method($value); # } # elsif($meta->relationship($name)) # { # $self->$name($value); # } # } # # return $self; # } our $Deflated = 0; sub init_with_deflated_tree { local $Deflated = 1; Rose::DB::Object::Helpers::init_with_tree(@_); } sub init_with_tree { my($self) = shift; my $meta = $self->meta; my %non_column; # Process all columns first while(my($name, $value) = each(%{@_ == 1 ? $_[0] : {@_}})) { next unless(length $name); if(my $column = $meta->column($name)) { local $self->{STATE_LOADING()} = 1 if($Deflated); my $method = $column->mutator_method_name; $self->$method($value); } else { $non_column{$name} = $value; } } # Process relationships and non-column attributes next while(my($name, $value) = each(%non_column)) { if(my $rel = $meta->relationship($name)) { my $method = $rel->method_name('get_set_on_save') || $rel->method_name('get_set') || next; my $ref = ref $value; if($ref eq 'HASH') { # Split hash into relationship values and everything else my %rel_vals; my %is_rel = map { $_->name => 1 } $rel->can('foreign_class') ? $rel->foreign_class->meta->relationships : $rel->class->meta->relationships; foreach my $k (keys %$value) { $rel_vals{$k} = delete $value->{$k} if($is_rel{$k}); } # %$value now has non-relationship keys only my $object = $self->$method(%$value); # Recurse on relationship key Rose::DB::Object::Helpers::init_with_tree($object, \%rel_vals) if(%rel_vals); # Repair original hash @$value{keys %rel_vals} = values %rel_vals; } elsif($ref eq 'ARRAY') { my(@objects, @sub_objects); foreach my $item (@$value) { # Split hash into relationship values and everything else my %rel_vals; my %is_rel = map { $_->name => 1 } $rel->can('foreign_class') ? $rel->foreign_class->meta->relationships : $rel->class->meta->relationships; foreach my $k (keys %$item) { $rel_vals{$k} = delete $item->{$k} if($is_rel{$k}); } # %$item now has non-relationship keys only push(@objects, { %$item }); # shallow copy is sufficient push(@sub_objects, \%rel_vals); # Repair original hash @$item{keys %rel_vals} = values %rel_vals; } # Add the related objects $self->$method(\@objects); # Recurse on the sub-objects foreach my $object (@{ $self->$method() }) { my $sub_objects = shift(@sub_objects); Rose::DB::Object::Helpers::init_with_tree($object, $sub_objects) if(%$sub_objects); } } else { Carp::cluck "Unknown reference encountered in $self tree: $name => $value"; } } elsif($self->can($name)) { $self->$name($value); } # XXX: Silently ignore all other name/value pairs } return $self; } sub new_from_tree { my $self = shift->new; $self->Rose::DB::Object::Helpers::init_with_tree(@_); } sub new_from_deflated_tree { my $self = shift->new; $self->Rose::DB::Object::Helpers::init_with_deflated_tree(@_); } __PACKAGE__->pre_import_hook(new_from_json => sub { require JSON }); __PACKAGE__->pre_import_hook(new_from_yaml => sub { require YAML::Syck }); sub new_from_json { new_from_tree(shift, __PACKAGE__->json_decoder->decode(@_)) } sub new_from_yaml { new_from_tree(shift, YAML::Syck::Load(@_)) } __PACKAGE__->pre_import_hook(init_with_json => sub { require JSON }); __PACKAGE__->pre_import_hook(init_with_yaml => sub { require YAML::Syck }); sub init_with_json { init_with_tree(shift, __PACKAGE__->json_decoder->decode(@_)) } sub init_with_yaml { init_with_tree(shift, YAML::Syck::Load(@_)) } __PACKAGE__->pre_import_hook(as_json => sub { require JSON }); __PACKAGE__->pre_import_hook(as_yaml => sub { require YAML::Syck }); sub as_json { __PACKAGE__->json_encoder->encode(scalar as_tree(@_, deflate => 1)) } sub as_yaml { YAML::Syck::Dump(scalar as_tree(@_, deflate => 1)) } sub dirty_columns { my($self) = shift; if(@_) { foreach my $column (@_) { my $name = UNIVERSAL::isa($column, 'Rose::DB::Object::Metadata::Column') ? $column->name : $column; Rose::DB::Object::Util::set_column_value_modified($self, $name); } return; } return wantarray ? keys %{$self->{MODIFIED_COLUMNS()}} : scalar keys %{$self->{MODIFIED_COLUMNS()}}; } 1; __END__ =head1 NAME Rose::DB::Object::Helpers - A mix-in class containing convenience methods for Rose::DB::Object. =head1 SYNOPSIS package MyDBObject; use Rose::DB::Object; our @ISA = qw(Rose::DB::Object); use Rose::DB::Object::Helpers 'clone', { load_or_insert => 'find_or_create' }; ... $obj = MyDBObject->new(id => 123); $obj->find_or_create(); $obj2 = $obj->clone; =head1 DESCRIPTION L provides convenience methods from use with L-derived classes. These methods do not exist in L in order to keep the method namespace clean. (Each method added to L is another potential naming conflict with a column accessor.) This class inherits from L. See the L documentation for a full explanation of how to import methods from this class. The helper methods themselves are described below. =head1 FUNCTIONS VS. METHODS Due to the "wonders" of Perl 5's object system, any helper method described here can also be used as a L-style utility I that takes a L-derived object as its first argument. Example: # Import two helpers use Rose::DB::Object::Helpers qw(clone_and_reset traverse_depth_first); $o = My::DB::Object->new(...); clone_and_reset($o); # Imported helper "method" called as function # Imported helper "method" with arguments called as function traverse_depth_first($o, handlers => { ... }, max_depth => 2); Why, then, the distinction between L methods and L functions? It's simply a matter of context. The functions in L are most useful in the context of the internals (e.g., writing your own L) whereas L methods are most often added to a common L-derived base class and then called as object methods by all classes that inherit from it. The point is, these are just conventions. Use any of these subroutines as functions or as methods as you see fit. Just don't forget to pass a L-derived object as the first argument when calling as a function. =head1 OBJECT METHODS =head2 as_json [PARAMS] Returns a JSON-formatted string created from the object tree as created by the L method. PARAMS are the same as for the L method, except that the C parameter is ignored (it is always set to true). You must have the L module version 2.12 or later installed in order to use this helper method. If you have the L module version 2.2222 or later installed, this method will work a lot faster. =head2 as_tree [PARAMS] Returns a reference to a hash of name/value pairs representing the column values of this object as well as any nested sub-objects. The PARAMS name/value pairs dictate the details of the sub-object traversal. Valid parameters are: =over 4 =item B If true, allow loops during the traversal (e.g., A -E B -E C -E A). The default value is false. =item B If true, the values in the tree will be simple scalars suitable for storage in the database (e.g., a date string like "2005-12-31" instead of a L object). The default is true. =item B A reference to a subroutine that is called on each L-derived object encountered during the traversal. It is passed the object, the parent object (undef, if none), and the L-derived object (undef, if none) that led to this object. If the subroutine returns true, then this object is not processed. Example: exclude => sub { my($object, $parent, $rel_meta) = @_; ... return 1 if($should_exclude); return 0; }, =item B If true, related sub-objects will be loaded from the database. If false, then only the sub-objects that have already been loaded from the database will be traversed. The default is false. =item B Do not descend past DEPTH levels. Depth is an integer starting from 0 for the object that the L method was called on and increasing with each level of related objects. The default value is 100. =item B If true, L will not be included in the tree. The default is false. =item B A reference to a subroutine that is called on each L-derived object encountered during traversal. It is passed the relationship object, the parent object, and the depth. If the subroutine returns true, then the entire sub-tree below this relationship will not be traversed. Example: prune => sub { my($rel_meta, $object, $depth) = @_; ... return 1 if($should_prune); return 0; }, =back B: Currently, you cannot have a relationship and a column with the same name in the same class. This should not happen without explicit action on the part of the class creator, but it is technically possible. The result of serializing such an object using L is undefined. This limitation may be removed in the future. The exact format of the "tree" data structure returned by this method is not public and may change in the future (e.g., to overcome the limitation described above). =head2 as_yaml [PARAMS] Returns a YAML-formatted string created from the object tree as created by the L method. PARAMS are the same as for the L method, except that the C parameter is ignored (it is always set to true). You must have the L module installed in order to use this helper method. =head2 clone Returns a new object initialized with the column values of the existing object. For example, imagine a C class with three columns, C, C, and C. $a = Person->new(id => 123, name => 'John', age => 30); This use of the C method: $b = $a->clone; is equivalent to this: $b = Person->new(id => $a->id, name => $a->name, age => $a->age); =head2 clone_and_reset This is the same as the L method described above, except that it also sets all of the L and L to undef. If the cloned object has a L attribute, then it is copied to the clone object as well. For example, imagine a C class with three columns, C, C, and C, where C is the primary key and C is a unique key. $a = Person->new(id => 123, name => 'John', age => 30, db => $db); This use of the C method: $b = $a->clone_and_reset; is equivalent to this: $b = Person->new(id => $a->id, name => $a->name, age => $a->age); $b->id(undef); # reset primary key $b->name(undef); # reset unique key $b->db($a->db); # copy db =head2 column_values_as_json Returns a string containing a JSON representation of the object's column values. You must have the L module version 2.12 or later installed in order to use this helper method. If you have the L module version 2.2222 or later installed, this method will work a lot faster. =head2 column_values_as_yaml Returns a string containing a YAML representation of the object's column values. You must have the L module installed in order to use this helper method. =head2 column_accessor_value_pairs Returns a hash (in list context) or reference to a hash (in scalar context) of column accessor method names and column values. The keys of the hash are the L for the columns. The values are retrieved by calling the L for each column. =head2 column_mutator_value_pairs Returns a hash (in list context) or reference to a hash (in scalar context) of column mutator method names and column values. The keys of the hash are the L for the columns. The values are retrieved by calling the L for each column. =head2 column_value_pairs Returns a hash (in list context) or reference to a hash (in scalar context) of column name and value pairs. The keys of the hash are the L of the columns. The values are retrieved by calling the L for each column. =head2 dirty_columns [ NAMES | COLUMNS ] Given a list of column names or L-derived objects, mark each column in the invoking object as L. If passed no arguments, returns a list of all modified columns in list context or the number of modified columns in scalar context. =head2 forget_related [ NAME | PARAMS ] Given a foreign key or relationship name, forget any L objects related by the specified foreign key or relationship. Normally, any objects loaded by the default accessor methods for relationships and foreign keys are fetched from the database only the first time they are asked for, and simply returned thereafter. Asking them to be "forgotten" causes them to be fetched anew from the database the next time they are asked for. If the related object name is passed as a plain string NAME, then a foreign key with that name is looked up. If no such foreign key exists, then a relationship with that name is looked up. If no such relationship or foreign key exists, a fatal error will occur. Example: $foo->forget_related('bar'); It's generally not a good idea to add a foreign key and a relationship with the same name, but it is technically possible. To specify the domain of the name, pass the name as the value of a C or C parameter. Example: $foo->forget_related(foreign_key => 'bar'); $foo->forget_related(relationship => 'bar'); =head2 has_loaded_related [ NAME | PARAMS ] Given a foreign key or relationship name, return true if one or more related objects have been loaded into the current object, false otherwise. If the name is passed as a plain string NAME, then a foreign key with that name is looked up. If no such foreign key exists, then a relationship with that name is looked up. If no such relationship or foreign key exists, a fatal error will occur. Example: $foo->has_loaded_related('bar'); It's generally not a good idea to add a foreign key and a relationship with the same name, but it is technically possible. To specify the domain of the name, pass the name as the value of a C or C parameter. Example: $foo->has_loaded_related(foreign_key => 'bar'); $foo->has_loaded_related(relationship => 'bar'); =head2 init_with_column_value_pairs [ HASH | HASHREF ] Initialize an object with a hash or reference to a hash of column/value pairs. This differs from the inherited L method in that it accepts column names rather than method names. A column name may not be the same as its mutator method name if the column is L, for example. $p = Person->new; # assume "type" column is aliased to "person_type" # init() takes method/value pairs $p->init(person_type => 'cool', age => 30); # Helper takes a hashref of column/value pairs $p->init_with_column_value_pairs({ type => 'cool', age => 30 }); # ...or a hash of column/value pairs $p->init_with_column_value_pairs(type => 'cool', age => 30); =head2 init_with_json JSON Initialize the object with a JSON-formatted string. The JSON string must be in the format returned by the L (or L) method. Example: $p1 = Person->new(name => 'John', age => 30); $json = $p1->as_json; $p2 = Person->new; $p2->init_with_json($json); print $p2->name; # John print $p2->age; # 30 =head2 init_with_deflated_tree TREE This is the same as the L method, except that it expects all the values to be simple scalars suitable for storage in the database (e.g., a date string like "2005-12-31" instead of a L object). In other words, the TREE should be in the format generated by the L method called with the C parameter set to true. Initializing objects in this way is slightly more efficient. =head2 init_with_tree TREE Initialize the object with a Perl data structure in the format returned from the L method. Example: $p1 = Person->new(name => 'John', age => 30); $tree = $p1->as_tree; $p2 = Person->new; $p2->init_with_tree($tree); print $p2->name; # John print $p2->age; # 30 =head2 init_with_yaml YAML Initialize the object with a YAML-formatted string. The YAML string must be in the format returned by the L (or L) method. Example: $p1 = Person->new(name => 'John', age => 30); $yaml = $p1->as_yaml; $p2 = Person->new; $p2->init_with_yaml($yaml); print $p2->name; # John print $p2->age; # 30 =head2 insert_or_update [PARAMS] If the object already exists in the database, then update it. Otherwise, insert it. Any PARAMS are passed on to the call to L (which is supplied with the appropriate C or C boolean parameter). This method differs from the standard L method in that L decides to L or L based solely on whether or not the object was previously Led. This method will take the extra step of actually attempting to L the object to see whether or not it's in the database. The return value of the L method is returned. =head2 insert_or_update_on_duplicate_key [PARAMS] Update or insert a row with a single SQL statement, depending on whether or not a row with the same primary or unique key already exists. Any PARAMS are passed on to the call to L (which is supplied with the appropriate C or C boolean parameter). If the current database does not support the "ON DUPLICATE KEY UPDATE" SQL extension, then this method simply calls the L method, passing all PARAMS. Currently, the only database that supports "ON DUPLICATE KEY UPDATE" is MySQL, and only in version 4.1.0 or later. You can read more about the feature here: L Here's a quick example of the SQL syntax: INSERT INTO table (a, b, c) VALUES (1, 2, 3) ON DUPLICATE KEY UPDATE a = 1, b = 2, c = 3; Note that there are two sets of columns and values in the statement. This presents a choice: which columns to put in the "INSERT" part, and which to put in the "UPDATE" part. When using this method, if the object was previously Led from the database, then values for all columns are put in both the "INSERT" and "UPDATE" portions of the statement. Otherwise, all columns are included in both clauses I those belonging to primary keys or unique keys which have only undefined values. This is important because it allows objects to be updated based on a single primary or unique key, even if other possible keys exist, but do not have values set. For example, consider this table with the following data: CREATE TABLE parts ( id INT PRIMARY KEY, code CHAR(3) NOT NULL, status CHAR(1), UNIQUE(code) ); INSERT INTO parts (id, code, status) VALUES (1, 'abc', 'x'); This code will update part id 1, setting its "status" column to "y". $p = Part->new(code => 'abc', status => 'y'); $p->insert_or_update_on_duplicate_key; The resulting SQL: INSERT INTO parts (code, status) VALUES ('abc', 'y') ON DUPLICATE KEY UPDATE code = 'abc', status = 'y'; Note that the "id" column is omitted because it has an undefined value. The SQL statement will detect the duplicate value for the unique key "code" and then run the "UPDATE" portion of the query, setting "status" to "y". This method returns true if the row was inserted or updated successfully, false otherwise. The true value returned on success will be the object itself. If the object Ls its boolean value such that it is not true, then a true value will be returned instead of the object itself. Yes, this method name is very long. Remember that you can rename methods on import. It is expected that most people will want to rename this method to "insert_or_update", using it in place of the normal L helper method: package My::DB::Object; ... use Rose::DB::Object::Helpers { insert_or_update_on_duplicate_key => 'insert_or_update' }; =head2 load_or_insert [PARAMS] Try to L the object, passing PARAMS to the call to the L method. The parameter "speculative => 1" is automatically added to PARAMS. If no such object is found, then the object is Led. Example: # Get object id 123 if it exists, otherwise create it now. $obj = MyDBObject->new(id => 123)->load_or_insert; =head2 load_or_save [PARAMS] Try to L the object, passing PARAMS to the call to the L method. The parameter "speculative => 1" is automatically added to PARAMS. If no such object is found, then the object is Ld. This methods differs from L in that the L method will also save sub-objects. See the documentation for L's L method for more information. Example: @perms = (Permission->new(...), Permission->new(...)); # Get person id 123 if it exists, otherwise create it now # along with permission sub-objects. $person = Person->new(id => 123, perms => \@perms)->load_or_insert; =head2 load_speculative [PARAMS] Try to L the object, passing PARAMS to the call to the L method along with the "speculative => 1" parameter. See the documentation for L's L method for more information. Example: $obj = MyDBObject->new(id => 123); if($obj->load_speculative) { print "Found object id 123\n"; } else { print "Object id 123 not found\n"; } =head2 new_from_json JSON The method is the equivalent of creating a new object and then calling the L method on it, passing JSON as an argument. See the L method for more information. =head2 new_from_deflated_tree TREE The method is the equivalent of creating a new object and then calling the L method on it, passing TREE as an argument. See the L method for more information. =head2 new_from_tree TREE The method is the equivalent of creating a new object and then calling the L method on it, passing TREE as an argument. See the L method for more information. =head2 new_from_yaml YAML The method is the equivalent of creating a new object and then calling the L method on it, passing YAML as an argument. See the L method for more information. =head2 strip [PARAMS] This method prepares an object for serialization by stripping out internal structures known to contain code references or other values that do not survive serialization. The object itself is returned, now stripped. B Operations that were scheduled to happen "on L" will I be stripped out by this method. Examples include the databsae update or insertion of any child objects attached to the parent object using C, C, or C methods. If such operations exist, an exception will be thrown unless the C parameter is true. If your object has these kinds of pending changes, either L first and then L, or L and then L the clone. By default, the L object and all sub-objects (foreign keys or relationships) are removed. PARAMS are optional name/value pairs. Valid PARAMS are: =over 4 =item B This parameter specifies which items to leave un-stripped. The value may be an item name or a reference to an array of item names. Valid names are: =over 4 =item B Do not remove the L object. The L object will have its DBI database handle (L) removed, however. =item B Do not removed sub-objects that have L by this object through L. =item B Do not removed sub-objects that have L by this object through L. =item B Do not remove any sub-objects (L or L) that have L by this object. This option is the same as specifying both the C and C names. =back =item B If true, do not throw an exception when pending "on-save" changes exist in the object; just strip them. (See description above for details.) =back =head2 B Do a depth-first traversal of the L-derived object that this method is called on, descending into related objects. If a reference to a subroutine is passed as the sole argument, it is taken as the value of the C key to the C parameter hash (see below). Otherwise, PARAMS name/value pairs are expected. Valid parameters are: =over 4 =item B If true, allow loops during the traversal (e.g., A -E B -E C -E A). The default value is false. =item B An arbitrary context variable to be passed along to (and possibly modified by) each handler routine (see C parameter below). The context may be any scalar value (e.g., an object, a reference to a hash, etc.) =item B A reference to a subroutine that is called on each L-derived object encountered during the traversal. It is passed the object, the parent object (undef, if none), and the L-derived object (undef, if none) that led to this object. If the subroutine returns true, then this object is not processed. Example: exclude => sub { my($object, $parent, $rel_meta) = @_; ... return 1 if($should_exclude); return 0; }, =item B If true, related sub-objects will be loaded from the database. If false, then only the sub-objects that have already been loaded from the database will be traversed. The default is false. =item B A reference to a hash of handler subroutines. Valid keys, calling context, and the arguments passed to the referenced subroutines are as follows. =over 4 =item B This handler is called whenever a L-derived object is encountered. This includes the object that L was called on as well as any sub-objects. The handler is passed the object, the C, the parent object (undef, if none), the L-derived object through which this object was arrived at (undef if none), and the depth. The handler I return the value to be used as the C during the traversal of any related sub-objects. The context returned may be different than the context passed in. Example: handlers => { object => sub { my($object, $context, $parent, $rel_meta, $depth) = @_; ... return $context; # Important! } ... } =item B This handler is called just before a L-derived object is descended into (i.e., just before the sub-objectes related through this relationship are processed). The handler is passed the object that contains the relationship, the C, the C, and the L object itself. The handler I return the value to be used as the C during the traversal of the objects related through this relationship. (If you do not define this handler, then the current context object will be used.) The context returned may be different than the context passed in. Example: handlers => { relationship => sub { my($object, $context, $rel_meta) = @_; ... return $context; # Important! } ... } =item B This handler is called after the traversal refuses to process a sub-object in order to avoid a loop. (This only happens if the C is parameter is false, obviously.) The handler is passed the object that was not processed, the C, the parent object, the I C, and the L-derived object through which the sub-object was related. Example: handlers => { loop_avoided => sub { my($object, $context, $parent, $prev_context, $rel_meta) = @_; ... } ... } =back =item B Do not descend past DEPTH levels. Depth is an integer starting from 0 for the object that the L method was called on and increasing with each level of related objects. The default value is 100. =item B A reference to a subroutine that is called on each L-derived object encountered during traversal. It is passed the relationship object, the parent object, and the depth. If the subroutine returns true, then the entire sub-tree below this relationship will not be traversed. Example: prune => sub { my($rel_meta, $object, $depth) = @_; ... return 1 if($should_prune); return 0; }, =back =head1 AUTHOR John C. Siracusa (siracusa@gmail.com) =head1 LICENSE Copyright (c) 2010 by John C. Siracusa. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Rose-DB-Object-0.810/lib/Rose/DB/Object/Iterator.pm000755 000765 000120 00000004530 12154726146 021521 0ustar00johnadmin000000 000000 package Rose::DB::Object::Iterator; use strict; use Carp(); use Rose::Object; our @ISA = qw(Rose::Object); our $VERSION = '0.759'; use Rose::Object::MakeMethods::Generic ( scalar => [ 'error', '_count', '_next_code', '_finish_code', '_destroy_code', ], 'boolean' => 'active', ); sub next { my($self) = shift; my $ret = $self->_next_code->($self, @_); $self->active(0) unless($ret); return $ret; } sub finish { my($self) = shift; $self->active(0); $self->_next_code(sub { 0 }); return $self->_finish_code->($self, @_); } sub DESTROY { my($self) = shift; if($self->active) { $self->finish; } elsif(my $code = $self->_destroy_code) { $code->($self); } } sub total { shift->{'_count'} } 1; __END__ =head1 NAME Rose::DB::Object::Iterator - Iterate over a series of Rose::DB::Objects. =head1 SYNOPSIS $iterator = Rose::DB::Object::Manager->get_objects_iterator(...); while($object = $iterator->next) { # do stuff with $object... if(...) # bail out early { $iterator->finish; last; } } if($iterator->error) { print "There was an error: ", $iterator->error; } else { print "Total: ", $iterator->total; } =head1 DESCRIPTION L is an iterator object that traverses a database query, returning L-derived objects for each row. L objects are created by calls to the L method of L or one of its subclasses. =head1 OBJECT METHODS =over 4 =item B Returns the text message associated with the last error, or false if there was no error. =item B Prematurely stop the iteration (i.e., before iterating over all of the available objects). =item B Return the next L-derived object. Returns false (but defined) if there are no more objects to iterate over, or undef if there was an error. =item B Returns the total number of objects iterated over so far. =back =head1 AUTHOR John C. Siracusa (siracusa@gmail.com) =head1 LICENSE Copyright (c) 2010 by John C. Siracusa. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Rose-DB-Object-0.810/lib/Rose/DB/Object/Loader.pm000755 000765 000120 00000160740 12235452534 021141 0ustar00johnadmin000000 000000 package Rose::DB::Object::Loader; use strict; use Cwd; use File::Path; use File::Spec; use DBI; use Carp; use Rose::DB; use Rose::DB::Object; use Rose::DB::Object::ConventionManager; use Rose::DB::Object::Metadata::Util qw(perl_hashref); use Rose::DB::Object::Metadata::Auto; use Rose::Object; our @ISA = qw(Rose::Object); our $VERSION = '0.799'; our $Debug = 0; use Rose::Object::MakeMethods::Generic ( scalar => [ 'db_catalog', 'db_database', 'db_schema', 'db_username', 'db_password', 'db_options', 'include_tables', 'exclude_tables', 'filter_tables', 'pre_init_hook', 'post_init_hook', 'module_dir', 'module_preamble', 'module_postamble', ], 'scalar --get_set_init' => [ 'with_relationships', ], boolean => [ 'using_default_base_class', 'require_primary_key' => { default => 1 }, 'include_views' => { default => 0 }, 'with_managers' => { default => 1 }, 'with_foreign_keys' => { default => 1 }, 'with_unique_keys' => { default => 1 }, 'convention_manager_was_set' => { default => 0 }, 'include_predicated_unique_indexes' => { default => 0 }, 'warn_on_missing_primary_key', 'no_auto_sequences' => { default => 0 }, ], ); sub warn_on_missing_pk { shift->warn_on_missing_primary_key(@_) } CHOOSE_CLONE: { local $@; # Get the best available clone method eval { require Scalar::Util::Clone; *clone = \&Scalar::Util::Clone::clone; }; if($@) { require Clone; *clone = \&Clone::clone; } } sub init_with_relationships { 1 } my $Base_Class_Counter = 1; sub generate_object_base_class_name { my($self) = shift; return ($self->class_prefix ? ($self->class_prefix . 'DB::Object::AutoBase') : 'Rose::DB::Object::LoaderGenerated::AutoBase') . $Base_Class_Counter++; } sub generate_db_base_class_name { my($self) = shift; return ($self->class_prefix ? ($self->class_prefix . 'DB::AutoBase') : 'Rose::DB::LoaderGenerated::AutoBase') . $Base_Class_Counter++; } sub generate_manager_class_name { my($self, $object_class, $cm) = @_; return $cm ? $cm->auto_manager_class_name($object_class) : $self->convention_manager->auto_manager_class_name($object_class); } sub base_classes { my($self) = shift; unless(@_) { if(my $bc = $self->{'base_classes'}) { return wantarray ? @$bc : $bc; } # Make new base class my $bc = $self->{'base_classes'} = [ $self->generate_object_base_class_name ]; $self->using_default_base_class(1); no strict 'refs'; @{"$bc->[0]::ISA"} = qw(Rose::DB::Object); return wantarray ? @$bc : $bc; } my $bc = shift; unless(ref $bc) { $bc = [ $bc ]; } #my $found_rdbo = 0; foreach my $class (@$bc) { unless($class =~ /^(?:\w+::)*\w+$/) { croak "Illegal base class name: $class"; } #$found_rdbo = 1 if(UNIVERSAL::isa($class, 'Rose::DB::Object')); } #unless($found_rdbo) #{ # croak "None of the base classes inherit from Rose::DB::Object"; #} $self->using_default_base_class(0); $self->{'base_classes'} = $bc; return wantarray ? @$bc : $bc; } sub base_class { shift->base_classes(@_) } use constant DEFAULT_MANAGER_BASE_CLASS => 'Rose::DB::Object::Manager'; sub manager_base_classes { my($self) = shift; if(my $bc = shift) { unless(ref $bc) { $bc = [ $bc ]; } #my $found_base = 0; foreach my $class (@$bc) { unless($class =~ /^(?:\w+::)*\w+$/) { croak "Illegal manager base class name: $class"; } #$found_base = 1 if(UNIVERSAL::isa($class, 'Rose::DB::Object::Manager')); } #unless($found_base) #{ # croak "None of the manager base classes inherit from ", # "Rose::DB::Object::Manager"; #} $self->{'manager_base_classes'} = $bc; } my $bc = $self->{'manager_base_classes'}; unless(defined $bc && @$bc) { return wantarray ? DEFAULT_MANAGER_BASE_CLASS : [ DEFAULT_MANAGER_BASE_CLASS ]; } return wantarray ? @{$self->{'manager_base_classes'}} : $self->{'manager_base_classes'} } sub manager_base_class { shift->manager_base_classes(@_) } sub convention_manager { my($self) = shift; if(@_) { my $cm = shift; if(ref $cm) { unless(UNIVERSAL::isa($cm, 'Rose::DB::Object::ConventionManager')) { croak "Not a Rose::DB::Object::ConventionManager-derived object: $cm"; } $self->{'convention_manager'} = $cm; } else { unless(UNIVERSAL::isa($cm, 'Rose::DB::Object::ConventionManager')) { croak "Not a Rose::DB::Object::ConventionManager-derived class: $cm"; } $self->{'convention_manager'} = $cm->new; } $self->convention_manager_was_set(1); } return $self->{'convention_manager'} ||= Rose::DB::Object::ConventionManager->new; } sub class_prefix { my($self) = shift; return $self->{'class_prefix'} unless(@_); my $class_prefix = shift; if(length $class_prefix) { unless($class_prefix =~ /^(?:\w+::)*\w+(?:::)?$/) { croak "Illegal class prefix: $class_prefix"; } $class_prefix .= '::' unless($class_prefix =~ /::$/); } return $self->{'class_prefix'} = $class_prefix; } sub force_lowercase { my($self) = shift; if(@_) { my $value = shift; # Important: allow this attribute to be set to undef, unlike # most "normal" boolean attributes. return $self->{'force_lowercase'} = undef unless(defined $value); return $self->{'force_lowercase'} = $value ? 1 : 0; } return $self->{'force_lowercase'}; } sub db { my($self) = shift; return $self->{'db'} unless(@_); my $db = shift; unless(UNIVERSAL::isa($db, 'Rose::DB')) { croak "Not a Rose::DB-derived object: $db"; } if(defined $db) { $self->{'db_class'} = $db->class; $self->{'db_dsn'} = undef; } return $self->{'db'} = $db; } sub db_dsn { my($self) = shift; return $self->{'db_dsn'} unless(@_); my $db_dsn = shift; if(my $db = $self->db) { $db->db_dsn($db_dsn); } return $self->{'db_dsn'} = $db_dsn; } sub dsn { shift->db_dsn(@_) } sub dbi_dsn { shift->db_dsn(@_) } sub db_class { my($self) = shift; return $self->{'db_class'} unless(@_); my $db_class = shift; unless($db_class =~ /^(?:\w+::)*\w+$/) { croak "Illegal class name: $db_class"; } unless(UNIVERSAL::isa($db_class, 'Rose::DB')) { my $error; TRY: { local $@; eval "require $db_class"; $error = $@; } no strict 'refs'; if(!$error && @{"${db_class}::ISA"} && !UNIVERSAL::isa($db_class, 'Rose::DB')) { croak "Not a Rose::DB-derived class: $db_class"; } } if(my $db = $self->db) { $self->db(undef) unless($db->class eq $db_class); } return $self->{'db_class'} = $db_class; } sub make_modules { my($self, %args) = @_; my $module_dir = exists $args{'module_dir'} ? delete $args{'module_dir'} : $self->module_dir; $module_dir = cwd() unless(defined $module_dir); unless(-d $module_dir) { croak "Module directory '$module_dir' does not exist"; } my(@extra_classes, %extra_info); $args{'extra_classes'} = \@extra_classes; $args{'extra_info'} = \%extra_info; my @classes = $self->make_classes(%args); foreach my $class (@classes, @extra_classes) { my @path = split('::', $class); $path[-1] .= '.pm'; unshift(@path, $module_dir); my $dir = File::Spec->catfile(@path[0 .. ($#path - 1)]); mkpath($dir) unless(-e $dir); unless(-d $dir) { if(-f $dir) { croak "Could not create module directory '$module_dir' - a file ", "with the same name already exists"; } croak "Could not create module directory '$module_dir' - $!"; } my $file = File::Spec->catfile(@path); open(my $pm, '>', $file) or croak "Could not create $file - $!"; my $preamble = exists $args{'module_preamble'} ? $args{'module_preamble'} : $self->module_preamble; my $postamble = exists $args{'module_postamble'} ? $args{'module_postamble'} : $self->module_postamble; if($class->isa('Rose::DB::Object')) { if($preamble) { my $this_preamble = ref $preamble eq 'CODE' ? $preamble->($class->meta) : $preamble; print {$pm} $this_preamble; } if($extra_info{'base_classes'}{$class}) { print {$pm} _perl_base_class($class, \%extra_info, \%args); } else { print {$pm} _perl_class($class, \%extra_info, \%args); } if($postamble) { my $this_postamble = ref $postamble eq 'CODE' ? $postamble->($class->meta) : $postamble; print {$pm} $this_postamble; } } elsif($class->isa('Rose::DB::Object::Manager')) { if($preamble) { my $this_preamble = ref $preamble eq 'CODE' ? $preamble->($class->object_class->meta, $class) : $preamble; print {$pm} $this_preamble; } print {$pm} $class->perl_class_definition(%args), "\n"; if($postamble) { my $this_postamble = ref $postamble eq 'CODE' ? $postamble->($class->object_class->meta, $class) : $postamble; print {$pm} $this_postamble; } } elsif($class->isa('Rose::DB')) { print {$pm} _perl_db_class($class, \%extra_info, \%args); } else { croak "Unknown class: $class" } close($pm) or croak "Could not write $file - $!"; } return wantarray ? @classes : \@classes; } sub _perl_class { my($class, $info, $args) = @_; my $auto_load = $args->{'auto_load_related_classes'}; my $old_auto_load = $class->meta->auto_load_related_classes; if(defined $auto_load) { $class->meta->auto_load_related_classes($auto_load); } my $code = $class->meta->perl_class_definition(%$args); if(defined $auto_load) { $class->meta->auto_load_related_classes($old_auto_load); } if(!$info->{'init_db_in_base_class'} && $info->{'perl_init_db'}) { my $init_db = $info->{'perl_init_db'}; $code =~ s/1;/$init_db\n\n1;/; } return $code . "\n"; } sub _perl_base_class { my($class, $info, $args) = @_; my $init_db = ''; if($info->{'init_db_in_base_class'} && $info->{'perl_init_db'}) { $init_db = "\n" . $info->{'perl_init_db'} . "\n"; } return<<"EOF"; package $class; use base 'Rose::DB::Object'; $init_db 1; EOF } sub _perl_db_class { my($class, $info, $args) = @_; my $max = 0; foreach my $key (keys %{$info->{'db_entry'}}) { $max = length($key) if(length($key) > $max); } my $hash = perl_hashref(hash => $info->{'db_entry'}, inline => 0, no_curlies => 1, key_padding => $max, indent => $args->{'indent'} || 2); return<<"EOF"; package $class; use strict; use base 'Rose::DB'; __PACKAGE__->use_private_registry; __PACKAGE__->register_db ( $hash ); 1; EOF } sub default_pre_init_hook { } sub default_post_init_hook { } sub make_classes { my($self, %args) = @_; my $extra_classes = delete $args{'extra_classes'}; my $extra_info = delete $args{'extra_info'}; my $db = delete $args{'db'}; $args{'stay_connected'} = 1; $args{'passive'} = 1 unless(exists $args{'passive'}); my $require_primary_key = exists $args{'require_primary_key'} ? delete $args{'require_primary_key'} : $self->require_primary_key; # Check for parameter alias conflicts if(exists $args{'warn_on_missing_pk'}) { if(exists $args{'warn_on_missing_primary_key'} && (($args{'warn_on_missing_pk'} ? 1 : 0) != ($args{'warn_on_missing_primary_key'} ? 1 : 0))) { croak "The warn_on_missing_primary_key and warn_on_missing_pk parameters ", "were both passed, and they conflict. Since these two parameters are ", "aliases for each other, try passing just one."; } $args{'warn_on_missing_primary_key'} = delete $args{'warn_on_missing_pk'}; } my $warn_on_missing_primary_key; # If not requiring PKs and no explicit decision, either in args or # in the object, has been made about whether to warn on missing PKs, # then don't warn (because not requiring PKs is a strong indication # that their absence is not worth a warning) if(!$require_primary_key && ((!exists $args{'warn_on_missing_primary_key'} && !defined $self->warn_on_missing_primary_key) || exists $args{'warn_on_missing_primary_key'} && !defined $args{'warn_on_missing_primary_key'})) { $warn_on_missing_primary_key = 0; } else { $warn_on_missing_primary_key = exists $args{'warn_on_missing_primary_key'} ? delete $args{'warn_on_missing_primary_key'} : $self->warn_on_missing_primary_key; } my $include_views = exists $args{'include_views'} ? delete $args{'include_views'} : $self->include_views; my $with_managers = exists $args{'with_managers'} ? delete $args{'with_managers'} : $self->with_managers; $args{'with_relationships'} = $self->with_relationships unless(exists $args{'with_relationships'}); $args{'with_foreign_keys'} = $self->with_foreign_keys unless(exists $args{'with_foreign_keys'}); $args{'with_unique_keys'} = $self->with_unique_keys unless(exists $args{'with_unique_keys'}); my $no_auto_sequences = exists $args{'no_auto_sequences'} ? delete $args{'no_auto_sequences'} : $self->no_auto_sequences; my $pre_init_hook = exists $args{'pre_init_hook'} ? delete $args{'pre_init_hook'} : $self->pre_init_hook; my $post_init_hook = exists $args{'post_init_hook'} ? delete $args{'post_init_hook'} : $self->post_init_hook; my $include = exists $args{'include_tables'} ? delete $args{'include_tables'} : $self->include_tables; my $exclude = exists $args{'exclude_tables'} ? delete $args{'exclude_tables'} : $self->exclude_tables; my $filter = exists $args{'filter_tables'} ? delete $args{'filter_tables'} : (!defined $include && !defined $exclude) ? $self->filter_tables : undef; if($include || $exclude) { if($filter) { croak "The filter_tables parameter and/or object attribute cannot ", "be used with the include_tables or exclude_tables parameters ", "or object attributes"; } if(defined $include) { if(ref $include eq 'ARRAY') { $include = '(?i)\A(?:' . join('|', map { quotemeta } @$include) . ')\z' } $include = qr((?i)$include); } if(defined $exclude) { if(ref $exclude eq 'ARRAY') { $exclude = '(?i)\A(?:' . join('|', map { quotemeta } @$exclude) . ')\z' } $exclude = qr((?i)$exclude); } $filter = sub { no warnings 'uninitialized'; return 0 if((defined $include && !/$include/) || (defined $exclude && /$exclude/)); return 1; }; } my $class_prefix = exists $args{'class_prefix'} ? delete $args{'class_prefix'} : $self->class_prefix || ''; if(length $class_prefix) { unless($class_prefix =~ /^(?:\w+::)*\w+(?:::)?$/) { croak "Illegal class prefix: $class_prefix"; } $class_prefix .= '::' unless($class_prefix =~ /::$/); } # Evil masking of object attribute local $self->{'class_prefix'} = $class_prefix; # When setting explicit values for attributes that cascade to # affect other attributes, save off the old values are restore # them at the end. my %save; if(exists $args{'db_class'}) { my $db_class = delete $args{'db_class'}; if($db && $db_class && $db_class ne $db->class) { Carp::croak "The db and db_class parameters conflict: ", $db->class, " vs. $db_class"; } if(defined(my $db_class = $self->db_class)) { $save{'db_class'} = $db_class; } if(defined(my $db = $self->db)) { $save{'db'} = $db; } $self->db_class($db_class); } # # Get or create the db object # $db ||= $self->db; my $db_class = $db ? $db->class : undef; my $made_new_db_class = 0; unless($db) { $db_class = $self->db_class; if($db_class) { unless(UNIVERSAL::isa($db_class, 'Rose::DB')) { my $error; TRY: { local $@; eval "require $db_class"; $error = $@; } if($error) { # Failed to load existing module unless($error =~ /^Can't locate $db_class\.pm/) { croak "Could not load db class '$db_class' - $error"; } # Make the class no strict 'refs'; @{"${db_class}::ISA"} = qw(Rose::DB); $db_class->registry(clone(Rose::DB->registry)); } } } else { $db_class = $self->generate_db_base_class_name; # Make a class no strict 'refs'; @{"${db_class}::ISA"} = qw(Rose::DB); $db_class->registry(clone(Rose::DB->registry)); push(@$extra_classes, $db_class) if($extra_classes); $made_new_db_class = 1; } } # Create the init_db subroutine that will be used with the objects my %db_args; if($db) { %db_args = ( type => $db->type, domain => $db->domain, ); delete $db_args{'type'} if($db_args{'type'} eq $db->default_type); delete $db_args{'domain'} if($db_args{'domain'} eq $db->default_domain); } foreach my $attr (qw(db_dsn db_catalog db_schema db_username db_password db_database)) { (my $db_attr = $attr) =~ s/^db_//; no strict 'refs'; $db_args{$db_attr} = $self->$attr() if(defined $self->$attr()); } $db_args{'connect_options'} = $self->db_options if(defined $self->db_options); # Set up the object base class my @base_classes = $self->base_classes; foreach my $class (@base_classes) { no strict 'refs'; unless(UNIVERSAL::isa($class, 'Rose::DB::Object') || @{"${class}::ISA"}) { my $error; TRY: { local $@; eval "require $class"; $error = $@; } croak $error if($error); } } my ($init_db, $need_new_init_db); # Check if the base class already has its own init_db my $can_rdbo = Rose::DB::Object->can('init_db'); my $can_base = $base_classes[0]->can('init_db'); unless($can_rdbo && $can_base && $can_rdbo ne $can_base) { $need_new_init_db = 1; } if($made_new_db_class) { if($db_args{'dsn'} && !$db_args{'driver'}) { if(DBI->can('parse_dsn')) { $db_args{'driver'} = lc((DBI->parse_dsn($db_args{'dsn'}))[1]); } unless($db_args{'driver'}) { $db_args{'dsn'} =~ /^dbi:(\w+)/i or Carp::croak "Could not extract driver name from DSN: $db_args{'dsn'}"; $db_args{'driver'} = lc $1; } } $db_class->register_db(domain => $db_class->default_domain, type => $db_class->default_type, %db_args); my $entry = $db_class->registry->entry(domain => $db_class->default_domain, type => $db_class->default_type); $extra_info->{'db_entry'} = { %db_args }; unless($entry->database) { # Need appropriate db just for parsing my $tmp_db = $db_class->new; my $database = $tmp_db->database_from_dsn($entry->dsn) or Carp::croak "Could not extract database name from DSN: ", $entry->dsn; $entry->database($database); $extra_info->{'database'} = $database; } $init_db = sub { $db_class->new }; $extra_info->{'perl_init_db'} = "use $db_class;\n\n" . "sub init_db { $db_class->new }"; } else { $init_db = $need_new_init_db ? sub { $db_class->new(%db_args) } : $can_base; my $hash = perl_hashref(hash => \%db_args, inline => 1, no_curlies => 1, indent => 0); if($need_new_init_db) { $extra_info->{'perl_init_db'} = "use $db_class;\n\n" . "sub init_db { $db_class->new($hash) }"; } } # Refresh the db $db = $init_db->(); $extra_info->{'init_db_in_base_class'} = 0; # Install the init_db routine in the base class, but only if # using the default base class. if($self->using_default_base_class) { no strict 'refs'; *{"$base_classes[0]::init_db"} = $init_db; $extra_info->{'init_db_in_base_class'} = 1; $extra_info->{'base_classes'}{$base_classes[0]}++; push(@$extra_classes, $base_classes[0]); } else { if($made_new_db_class || $db_class ne 'Rose::DB') { if($need_new_init_db) { no strict 'refs'; no warnings; *{"$base_classes[0]::init_db"} = $init_db; } $extra_info->{'init_db_in_base_class'} = 1; $extra_info->{'base_classes'}{$base_classes[0]}++; } else { foreach my $base_class (@base_classes) { if($base_class->can('init_db')) { $extra_info->{'init_db_in_base_class'} = 1; last; } } } } my $force_lowercase; if(exists $args{'force_lowercase'}) { $force_lowercase = delete $args{'force_lowercase'}; } else { unless(defined($force_lowercase = $self->force_lowercase)) { $force_lowercase = $db->driver eq 'oracle' ? 1 : 0; } } my $cm; # XXX: Lame way to check if the convention_manager attribute has # XXX: been set or fetched. if($self->{'convention_manager'}) { $cm = $self->convention_manager; } else { $cm = $base_classes[0]->meta->convention_manager; $self->convention_manager($cm); } die "Missing convention manager" unless($cm); # Propagate CM-relevant attributes $cm->force_lowercase($force_lowercase); $cm->no_auto_sequences($no_auto_sequences); $self->convention_manager($cm); my @classes; my %list_args; $list_args{'include_views'} = 1 if($include_views); # XXX: Horrible hack. Replce eventually... local $Rose::DB::Object::Metadata::Auto::Missing_PK_OK = $require_primary_key ? 0 : 1; my %created; # Iterate over tables, creating RDBO classes for each foreach my $table ($db->list_tables(%list_args)) { local $_ = $table; next unless(!$filter || $filter->($table)); unless($db->has_primary_key($table)) { if($warn_on_missing_primary_key) { # Warn about tables with no primary keys warn "Warning: table '$table' has no primary key defined.", ($require_primary_key ? " Skipping.\n" : "\n"); } # Skip table if primary keys are required next if($require_primary_key); } my $obj_class = $class_prefix . $cm->table_to_class($table); $Debug && warn "Loader loading table: $table - $obj_class\n"; no strict 'refs'; # Skip classes that have already been created #if($obj_class->isa('Rose::DB::Object') && $obj_class->meta->is_initialized) if($created{$obj_class}) { $Debug && warn "Skipping: $obj_class already initialized\n"; next; } # Set up the class @{"${obj_class}::ISA"} = @base_classes; unless($extra_info->{'init_db_in_base_class'}) { *{"${obj_class}::init_db"} = $init_db; } my $meta = $obj_class->meta; $meta->db($db); if($pre_init_hook) { if(ref $pre_init_hook eq 'CODE') { $pre_init_hook = [ $pre_init_hook ]; } elsif(ref $pre_init_hook ne 'ARRAY') { Carp::croak "Invalid pre_init_hook: $pre_init_hook"; } } unshift(@$pre_init_hook, sub { $self->default_pre_init_hook(@_) }); $meta->pre_init_hook($pre_init_hook); if($post_init_hook) { if(ref $post_init_hook eq 'CODE') { $post_init_hook = [ $post_init_hook ]; } elsif(ref $post_init_hook ne 'ARRAY') { Carp::croak "Invalid post_init_hook: $post_init_hook"; } } unshift(@$post_init_hook, sub { $self->default_post_init_hook(@_) }); $meta->post_init_hook($post_init_hook); $meta->table($table); $meta->convention_manager($cm->clone); $meta->db($db); my $include_predicated_unique_indexes = exists $args{'include_predicated_unique_indexes'} ? delete $args{'include_predicated_unique_indexes'} : $self->include_predicated_unique_indexes; $meta->include_predicated_unique_indexes($include_predicated_unique_indexes); $meta->auto_initialize(%args); push(@classes, $obj_class); $created{$obj_class}++; # Make the manager class if($with_managers) { my $mgr_class = $self->generate_manager_class_name($obj_class, $cm); $meta->make_manager_class( class => $mgr_class, base_name => $cm->auto_manager_base_name($table, $obj_class), isa => scalar $self->manager_base_classes); push(@classes, $mgr_class); } } if(@classes) { my $meta = $classes[0]->meta; # Retry deferred stuff: two passes for(1 .. 2) { $meta->retry_deferred_tasks; $meta->retry_deferred_foreign_keys; $meta->retry_deferred_relationships; } $classes[0]->meta_class->clear_all_dbs; } if(%save) { while(my($method, $value) = each(%save)) { $self->$method($value); } } return wantarray ? @classes : \@classes; } 1; __END__ =head1 NAME Rose::DB::Object::Loader - Automatically create Rose::DB::Object subclasses based on database table definitions. =head1 SYNOPSIS Sample database schema: CREATE TABLE vendors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ); CREATE TABLE products ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, price DECIMAL(10,2) NOT NULL DEFAULT 0.00, vendor_id INT REFERENCES vendors (id), status VARCHAR(128) NOT NULL DEFAULT 'inactive' CHECK(status IN ('inactive', 'active', 'defunct')), date_created TIMESTAMP NOT NULL DEFAULT NOW(), release_date TIMESTAMP, UNIQUE(name) ); CREATE TABLE prices ( id SERIAL NOT NULL PRIMARY KEY, product_id INT NOT NULL REFERENCES products (id), region CHAR(2) NOT NULL DEFAULT 'US', price DECIMAL(10,2) NOT NULL DEFAULT 0.00, UNIQUE(product_id, region) ); CREATE TABLE colors ( id SERIAL NOT NULL PRIMARY KEY, name VARCHAR(255) NOT NULL, UNIQUE(name) ); CREATE TABLE product_color_map ( product_id INT NOT NULL REFERENCES products (id), color_id INT NOT NULL REFERENCES colors (id), PRIMARY KEY(product_id, color_id) ); To start, make a L object, specifying the database connection information and an optional class name prefix. $loader = Rose::DB::Object::Loader->new( db_dsn => 'dbi:Pg:dbname=mydb;host=localhost', db_username => 'someuser', db_password => 'mysecret', db_options => { AutoCommit => 1, ChopBlanks => 1 }, class_prefix => 'My::Corp'); It's even easier to specify the database information if you've set up L (say, by following the instructions in L). Just pass a L-derived object pointing to the database you're interested in. $loader = Rose::DB::Object::Loader->new( db => My::Corp::DB->new('main'), class_prefix => 'My::Corp'); Finally, automatically create L subclasses for all the tables in the database. All it takes is one method call. $loader->make_classes; Here's what you get for your effort. $p = My::Corp::Product->new(name => 'Sled'); $p->vendor(name => 'Acme'); $p->prices({ price => 1.23, region => 'US' }, { price => 4.56, region => 'UK' }); $p->colors({ name => 'red' }, { name => 'green' }); $p->save; $products = My::Corp::Product::Manager->get_products_iterator( query => [ name => { like => '%le%' } ], with_objects => [ 'prices' ], require_objects => [ 'vendor' ], sort_by => 'vendor.name'); $p = $products->next; print $p->vendor->name; # Acme # US: 1.23, UK: 4.56 print join(', ', map { $_->region . ': ' . $_->price } $p->prices); See the L and L documentation for learn more about the features these classes provide. The contents of the database now look like this. mydb=# select * from products; id | name | price | vendor_id | status | date_created ----+--------+-------+-----------+----------+------------------------- 1 | Sled 3 | 0.00 | 1 | inactive | 2005-11-19 22:09:20.7988 mydb=# select * from vendors; id | name ----+-------- 1 | Acme 3 mydb=# select * from prices; id | product_id | region | price ----+------------+--------+------- 1 | 1 | US | 1.23 2 | 1 | UK | 4.56 mydb=# select * from colors; id | name ----+------- 1 | red 2 | green mydb=# select * from product_color_map; product_id | color_id ------------+---------- 1 | 1 1 | 2 =head1 DESCRIPTION L will automatically create L subclasses for all the tables in a database. It will configure column data types, default values, primary keys, unique keys, and foreign keys. It can also discover and set up inter-table L. It uses L's L capabilities to do all of this. To do its work, the loader needs to know how to connect to the database. This information can be provided in several ways. The recommended practice is to set up L according to the instructions in the L, and then pass a L-derived object or class name to the loader. The loader will also accept traditional L-style connection information: DSN, username, password, etc. Once the loader object is configured, the L method does all the work. It takes a few options specifying which tables to make classes for, whether or not to make L classes for each table, and a few other L. The L is used to convert table names to class names, generate foreign key and relationship method names, and so on. The result of this process is a suite of L (and L) subclasses ready for use. L inherits from, and follows the conventions of, L. See the L documentation for more information. =head1 GOTCHAS Database schema information is extracted using L's schema interrogation methods, which dutifully report exactly how the database describes itself. In some cases, what the database reports about a particular table may not exactly match what you specified in your table definition. The most egregious offender is (surprise!) MySQL, which, to give just one example, tends to offer up empty string default values for non-null character columns. That is, if you write a table definition like this: CREATE TABLE widgets ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, name VARCHAR(64) NOT NULL ); and then interrogate it using L, you will find that the "name" column has a default value (as reflected in the C column returned by L's L method) of '' (i.e., an empty string). In other words, it's as if your table definition was this instead: CREATE TABLE widgets ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, name VARCHAR(64) NOT NULL DEFAULT '' ); MySQL is full of such surprises, and it's not the only database to do such things. Consult the documentation for your database (or do a Google search for "EmydbnameE gotchas") for the gory details. To work around these kinds of problems, try the L feature. For example, in your L subroutine you could walk over the list of L for each class, eliminating all the empty string default values (i.e., changing them to undef instead). =head1 CONSTRUCTOR =over 4 =item B Returns a new L constructed according to PARAMS, where PARAMS are name/value pairs. Any object method is a valid parameter name. =back =head1 OBJECT METHODS =over 4 =item B This is an alias for the L method. =item B Get or set the list of base classes to use for the L subclasses created by the L method. The argument may be a class name or a reference to an array of class names. At least one of the classes should inherit from L. Returns a list (in list context) or reference to an array (in scalar context) of base class names. Defaults to a dynamically-generated L subclass name. =item B Get or set the prefix affixed to all class names created by the L method. If PREFIX doesn't end in "::", it will be added automatically. =item B Get or set the L-derived class name or object to be used during the L process for each class created by the L method. Returns a L-derived object, which defaults to a new L object. Unless this attribute is explicitly set or fetched before the call to the L method, the convention manager object used by L will be produced by calling the L method of the metadata object of the first (left-most) L. =item B Get or set the L-derived object used to connect to the database. This object will be used by the L method when extracting information from the database. It will also be used as the prototype for the L object used by each L subclass to connect to the database. Setting this attribute also sets the L attributes, overwriting any previously existing value, and sets the L value to undef. =item B Get or set the L for the database connection. =item B Get or set the name of the L-derived class used by the L method to construct a L object if one has not been set via the method of the same name. Setting this attribute sets the L attribute to undef unless its class is the same as CLASS. =item B Get or set the L-style Data Source Name (DSN) used to connect to the database. This will be used by the L method when extracting information from the database. The L-derived objects used by each L subclass to connect to the database will be initialized with this DSN. Setting this attribute immediately sets the L of the L attribute, if it is defined. =item B Get or set the L used to connect to the database. =item B Get or set the L used to connect to the database. =item B Get or set the L for the database connection. =item B Get or set the L used to connect to the database. =item B Get or set a regular expression or reference to an array of table names to exclude. Table names that match REGEX or are contained in ARRAYREF will be skipped by default during calls to the L method. Tables without primary keys are automatically (and always) skipped. Table names are compared to REGEX and the names in ARRAYREF in a case-insensitive manner. To override this in the case of the REGEX, add C<(?-i)> to the front of the REGEX. Otherwise, use the L method instead. =item B Get or set a reference to a subroutine that takes a single table name argument and returns true if the table should be processed by default during calls to the L method, false if the table should be skipped. The C<$_> variable will also be set to the table name before the call to CODEREF. This attribute should not be combined with the L or L attributes. =item B Get or set a boolean value that indicates whether or not L entity names should be forced to lowercase even when the related entity (e.g., table or column name) is uppercase or mixed case. ("Metadata entities" are thing like L, L, and L.) The default value undef. =item B Given the name of a L-derived class, returns a class name for a L-derived class to manage such objects. The default implementation calls the L method on the convention manager object passed as the optional CM argument, or returned from the L method if a CM argument is not passed. =item B Get or set a regular expression or reference to an array of table names to include. Table names that do not match REGEX or are not contained in ARRAYREF will be skipped by default during calls to the L method. Tables without primary keys are automatically (and always) skipped. Table names are compared to REGEX and the names in ARRAYREF in a case-insensitive manner. To override this in the case of the REGEX, add C<(?-i)> to the front of the REGEX. Otherwise, use the L method instead. =item B Get or set a boolean value that will be assigned to the L attribute of the L object for each class created by the L method. The default value is false. =item B If true, database views will also be processed by default during calls to the L method. Defaults to false. =item B Automatically create L and (optionally) L subclasses for some or all of the tables in a database. The class creation process is controlled by the loader object's attributes. Optional name/value pairs passed to this method may override some of those values. Valid PARAMS are: =over 4 =item B The L-derived object used to connect to the database. This object will also be used as the prototype for the L object used by each L subclass created by this call to L. Defaults to the value of the loader object's L attribute. =item B The name of the L-derived class used to construct a L object if one has not been set via the parameter or object attribute of the same name. Defaults to the value of the loader object's L attribute. =item B Table names that do not match REGEX or are not contained in ARRAYREF will be skipped. Defaults to the value of the loader object's L attribute. Tables without primary keys are automatically (and always) skipped. Table names are compared to REGEX and the names in ARRAYREF in a case-insensitive manner. To override this in the case of the REGEX, add C<(?-i)> to the front of the REGEX. Otherwise, use the C parameter instead. =item B Table names that match REGEX or are contained in ARRAYREF will be skipped. Defaults to the value of the loader object's L attribute. Tables without primary keys are automatically (and always) skipped. Table names are compared to REGEX and the names in ARRAYREF in a case-insensitive manner. To override this in the case of the REGEX, add C<(?-i)> to the front of the REGEX. Otherwise, use the C parameter instead. =item B A reference to a subroutine that takes a single table name argument and returns true if the table should be processed, false if it should be skipped. The C<$_> variable will also be set to the table name before the call. This parameter cannot be combined with the C or C options. Defaults to the value of the loader object's L attribute, provided that both the C and C values are undefined. Tables without primary keys are automatically skipped. =item B A boolean value that indicates whether or not L entity names should be forced to lowercase even when the related entity is uppercase or mixed case. ("Metadata entities" are thing like L, L, and L.) If this parameter is omitted and if the loader object's L attribute is not defined, then the value is chosen based on the database currently being examined. If the database is Oracle, then it defaults to true. Otherwise, it defaults to false. The final value is propagated to the L L. =item B This value will be assigned to the L attribute of the L object for each class created by this method. Defaults to the value of the loader object's L attribute. =item B If true, database views will also be processed. Defaults to the value of the loader object's L attribute. =item B A reference to a subroutine or a reference to an array of code references that will be called just after each L-derived class is Ld. Each referenced subroutine will be passed the class's L object plus any arguments to the L method. Defaults to the value of the loader object's L attribute. =item B A reference to a subroutine or a reference to an array of code references that will be called just before each L-derived class is Ld. Each referenced subroutine will be passed the class's L object plus any arguments to the L method. Defaults to the value of the loader object's L attribute. =item B If true, then any table that does not have a primary key will be skipped. Defaults to the value of the loader object's L attribute. Note that a L-derived class based on a table with no primary key will not function correctly in all circumstances. Use this feature at your own risk. =item B This is an alias for the C parameter. =item B If true, then any table that does not have a primary key will trigger a warning. If C is false and the loader object's L attribute is undefined, or if the C parameter is set to an undefined value or is not passed to the L call at all, then C is set to false. Otherwise, it defaults to the value of the loader object's L attribute. Note that a L-derived class based on a table with no primary key will not function correctly in all circumstances. These complicated defaults are intended to honor the intentions of the C attribute/parameter. If not requiring primary keys and no explicit decision has been made about whether to warn about missing primary keys, either in the parameters to the L call or in the loader object itself, then we don't warn about missing primary keys. The idea is that not requiring primary keys is a strong indication that their absence is not worth a warning. =item B If true, set up foreign key metadata for each L-derived. Defaults to the value of the loader object's L attribute. =item B If true, create L-derived manager classes for each L subclass. Defaults to the value of the loader object's L attribute. The manager class name is determined by passing the L-derived class name to the L method. The L subclass's L's L method will be used to create the manager class. It will be passed the return value of the convention manager's L method as an argument. =item B A boolean value or a reference to an array of relationship L names. If set to a simple boolean value, then all types of relationships will be considered when making classes. If set to a list of relationship type names, then only relationships of those types will be considered. Defaults to the value of the loader object's L attribute. =item B If true, set up unique key metadata for each L-derived. Defaults to the value of the loader object's L attribute. =back Any remaining name/value parameters will be passed on to the call to L used to set up each class. For example, to ask the loader not to create any L, pass the C parameter with a false value. $loader->make_classes(with_relationships => 0); This parameter will be passed on to the L method, which, in turn, will pass the parameter on to its own call to the L method. See the L documentation for more information on these methods. Each L subclass will be created according to the "best practices" described in the L. If a L is not provided, one (with a dynamically generated name) will be created automatically. The same goes for the L object. If one is not set, then a new (again, dynamically named) subclass of L, with its own L, will be created automatically. This method returns a list (in list context) or a reference to an array (in scalar context) of the names of all the classes that were created. (This list will include L class names as well, if any were created.) =item B Automatically create L and (optionally) L subclasses for some or all of the tables in a database, then create Perl module (*.pm) files for each class. This method calls L to make the actual classes. B If you are trying to regenerate a set of module files that already exist in the target C, please make sure that this C is I in your C<@INC> path. (That is, make sure it is not in the set of paths that perl will search when looking for module files in response to a C or C statement.) More generally, you must make sure that existing versions of the modules you are attempting to generate are not in your C<@INC> path. (If you do not do this, when L makes a class and looks for a related class, it will find and load the previously generated C<.pm> file, which will then cause L to skip that class later when it sees that it already exists in memory. And if L skips it, L will never see it and therefore will never regenerate the C<.pm> file.) This method takes all of the same parameters as L, with several additions: =over 4 =item B The path to the directory where the Perl module files will be created. For example, given a DIR of "/home/john/lib", the Perl module file for the class C would be located at "/home/john/lib/My/DB/Object.pm". Defaults to the value of the loader object's L attribute. If the L attribute is also undefined, then the current working directory (as determined by a call to L) is used instead. =item B If defined as a scalar, inserts the contents of the variable into the auto-generated file before any of the auto-generated class information. If provided as a code ref, calls the indicated function, passing the L as a parameter. (The metadata object that belongs to the C and the L-derived class name are passed if the module is a L-derived class.) The returned value of the function is inserted as the preamble text. Defaults to the value of the loader object's L attribute. =item B If defined as a scalar, inserts the contents of the variable into the auto-generated file after any of the auto-generated class information. If provided as a code ref, calls the indicated function, passing the L as a parameter. (The metadata object that belongs to the C and the L-derived class name are passed if the module is a L-derived class.) The returned value of the function is inserted as the postamble text. Defaults to the value of the loader object's L attribute. =back =item B Get or set the path to the directory where L will create its Perl modules files. For example, given a DIR of "/home/john/lib", L would create the file "/home/john/lib/My/DB/Object.pm" for the class C. =item B If defined as a scalar, inserts the contents of the variable into the auto-generated file before any of the auto-generated class information. If provided as a code ref, calls the indicated function, passing the L as a parameter. (The metadata object that belongs to the C and the L-derived class name are passed if the module is a L-derived class.) The returned value of the function is inserted as the preamble text. =item B If defined as a scalar, inserts the contents of the variable into the auto-generated file after any of the auto-generated class information. If provided as a code ref, calls the indicated function, passing the L as a parameter. (The metadata object that belongs to the C and the L-derived class name are passed if the module is a L-derived class.) The returned value of the function is inserted as the postamble text. =item B Get or set a reference to a subroutine to be called just before each L-derived class is Led within the L method. The subroutine will be passed the class's L object as an argument. =item B Get or set a boolean value that determines whether or not the L method will skip any table that does not have a primary key will be skipped. Defaults to true. Note that a L-derived class based on a table with no primary key will not function correctly in all circumstances. Use this feature at your own risk. =item B This is an alias for the L method. =item B Get or set a boolean value that determines whether or not the L method will emit a warning when it encounters a table that does not have a primary key. Defaults to undefined. =item B If true, the L method will set up foreign key metadata for each L-derived class it creates. Defaults to true. =item B If true, the L method will create L-derived manager classes for each L subclass by default. Defaults to true. The manager class name is determined by passing the L-derived class name to the L method. The L subclass's L's L method will be used to create the manager class. It will be passed the return value of the convention manager's L method as an argument. =item B A boolean value or a reference to an array of relationship L names. If set to a simple boolean value, then the L method will consider all types of relationships when making classes. If set to a list of relationship type names, then only relationships of those types will be considered by L. Defaults to true. =item B If true, the L method will set up unique key metadata for each L-derived class it creates. Defaults to true. =item B This is an alias for the L method. =item B Get or set the list of base classes to use for the L subclasses created by the L method. The argument may be a class name or a reference to an array of class names. At least one of the classes should inherit from L. Returns a list (in list context) or reference to an array (in scalar context) of base class names. Defaults to L. =back =head1 AUTHOR John C. Siracusa (siracusa@gmail.com) =head1 LICENSE Copyright (c) 2010 by John C. Siracusa. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Rose-DB-Object-0.810/lib/Rose/DB/Object/MakeMethods/000750 000765 000120 00000000000 12266514755 021566 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/lib/Rose/DB/Object/Manager.pm000755 000765 000120 00000542721 12235452534 021310 0ustar00johnadmin000000 000000 package Rose::DB::Object::Manager; use strict; use Carp(); use List::Util qw(first); #use List::MoreUtils qw(uniq); use Scalar::Util qw(weaken refaddr); use Rose::DB::Object::Iterator; use Rose::DB::Object::QueryBuilder qw(build_select build_where_clause); use Rose::DB::Object::Constants qw(PRIVATE_PREFIX STATE_LOADING STATE_IN_DB MODIFIED_COLUMNS); # XXX: A value that is unlikely to exist in a primary key column value use constant PK_JOIN => "\0\2,\3\0"; our $VERSION = '0.790'; our $Debug = 0; # # Class data # use Rose::Class::MakeMethods::Generic ( inheritable_scalar => [ 'error', 'total', 'error_mode', '_object_class', '_base_name', '_default_manager_method_types', 'default_objects_per_page', 'default_limit_with_subselect', 'default_nested_joins', 'dbi_prepare_cached', 'strict_ops', ], ); __PACKAGE__->error_mode('fatal'); __PACKAGE__->default_objects_per_page(20); __PACKAGE__->default_limit_with_subselect(1); __PACKAGE__->default_nested_joins(1); __PACKAGE__->dbi_prepare_cached(0); __PACKAGE__->strict_ops(0); __PACKAGE__->default_manager_method_types(qw(objects iterator count delete update)); sub handle_error { my($class, $object) = @_; my $mode = $class->error_mode; return if($mode eq 'return'); my $level = $Carp::CarpLevel; local $Carp::CarpLevel = $level + 1; if($mode eq 'croak' || $mode eq 'fatal') { Carp::croak $object->error; } elsif($mode eq 'carp') { Carp::carp $object->error; } elsif($mode eq 'cluck') { Carp::croak $object->error; } elsif($mode eq 'confess') { Carp::confess $object->error; } else { Carp::croak "(Invalid error mode set: '$mode') - ", $object->error; } return 1; } sub normalize_get_objects_args { # Handle all these arg forms: # # get_objects(a => b, c => d, ...); # get_objects([ ... ], a => b, c => d, ...) # get_objects({ ... }, a => b, c => d, ...) if(ref $_[1]) { my $class = shift; if(ref $_[0] eq 'HASH') { return ($class, query => [ %{shift(@_)} ], @_); } elsif(ref $_[0] eq 'ARRAY') { return ($class, query => shift, @_); } else { Carp::croak 'Invalid arguments: ', join(', ', @_) } } return @_; } # XXX: These are duplicated from ManyToMany.pm because I don't want to use() # XXX: that module from here if I don't have to. Lazy or foolish? Hm. # XXX: Anyway, make sure they stay in sync! use constant MAP_RECORD_METHOD => 'map_record'; use constant DEFAULT_REL_KEY => PRIVATE_PREFIX . '_default_rel_key'; sub object_class { } sub default_manager_method_types { my($class) = shift; if(@_) { if(@_ == 1 && ref $_[0] eq 'ARRAY') { $class->_default_manager_method_types(@_); } else { $class->_default_manager_method_types([ @_ ]); } } return wantarray ? @{$class->_default_manager_method_types} : $class->_default_manager_method_types; } sub make_manager_methods { my($class) = shift; if(@_ == 1) { @_ = (methods => { $_[0] => [ $class->default_manager_method_types ] }); } else { Carp::croak "make_manager_methods() called with an odd number of arguments" unless(@_ % 2 == 0); } my %args = @_; local $Debug = $args{'debug'} if(exists $args{'debug'}); my $calling_class = ($class eq __PACKAGE__) ? (caller)[0] : $class; my $target_class = $args{'target_class'} || $calling_class; my $object_class = $args{'object_class'}; my $class_invocant = UNIVERSAL::isa($target_class, __PACKAGE__) ? $target_class : __PACKAGE__; unless($object_class) { if(UNIVERSAL::isa($target_class, 'Rose::DB::Object::Manager')) { $object_class = $target_class->object_class; } if(!$object_class && UNIVERSAL::isa($target_class, 'Rose::DB::Object')) { $object_class = $target_class; } } unless($object_class) { Carp::croak "Could not determine object class. Please pass a value for ", "the object_class parameter", (UNIVERSAL::isa($target_class, 'Rose::DB::Object::Manager') ? " or override the object_class() method in $target_class" : ''); } unless(UNIVERSAL::isa($object_class, 'Rose::DB::Object')) { my $error; TRY: { local $@; eval "require $object_class"; $error = $@; } if($error) { Carp::croak "Could not load object class $object_class - $error"; } } my $meta = $object_class->meta; my $cm = $meta->convention_manager; my $base_name = $args{'base_name'} || $cm->auto_manager_base_name($meta->table, $object_class); if(!$args{'methods'}) { unless($base_name) { Carp::croak "Missing methods parameter and base_name parameter, and the ", "convention manager's auto_manager_base_name() method did not ", "return a true value" } $args{'methods'} = { $base_name => [ $class->default_manager_method_types ] }; } elsif($args{'base_name'}) { Carp::croak "Please pass the methods parameter OR the base_name parameter, not both"; } Carp::croak "Invalid 'methods' parameter - should be a hash ref" unless(ref $args{'methods'} eq 'HASH'); $class->_base_name($base_name); $class->_object_class($object_class); while(my($name, $types) = each %{$args{'methods'}}) { $class->_base_name($name) unless($base_name); my $have_full_name = ($name =~ s/\(\)$//) ? 1 : 0; Carp::croak "Invalid value for the '$name' parameter" if(ref $types && ref $types ne 'ARRAY'); if($have_full_name && ref $types && @$types > 1) { Carp::croak "Cannot use explicit method name $name() with more ", "than one method type"; } foreach my $type ((ref $types ? @$types : ($types))) { no strict 'refs'; if($type eq 'objects') { my $method_name = $have_full_name ? $name : ($cm->auto_manager_method_name($type, $base_name, $object_class) || "get_$name"); foreach my $class ($target_class, $class_invocant) { my $method = "${class}::$method_name"; my $short_method = $method_name; Carp::croak "A $method method already exists" if(defined &{$method}); Carp::croak "The $short_method method is inherited from Rose::DB::Object::Manager ", "and cannot be overriden in $target_class" if(Rose::DB::Object::Manager->can($short_method)); } $Debug && warn "Making method: $target_class->$method_name()\n"; *{"${target_class}::$method_name"} = sub { shift; $class_invocant->get_objects(@_, object_class => $object_class); }; } elsif($type eq 'count') { my $method_name = $have_full_name ? $name : ($cm->auto_manager_method_name($type, $base_name, $object_class) || "get_${name}_count"); foreach my $class ($target_class, $class_invocant) { my $method = "${class}::$method_name"; Carp::croak "A $method method already exists" if(defined &{$method}); } $Debug && warn "Making method: $target_class->$method_name()\n"; *{"${target_class}::$method_name"} = sub { shift; $class_invocant->get_objects( @_, count_only => 1, object_class => $object_class) }; } elsif($type eq 'iterator') { my $method_name = $have_full_name ? $name : ($cm->auto_manager_method_name($type, $base_name, $object_class) || "get_${name}_iterator"); foreach my $class ($target_class, $class_invocant) { my $method = "${class}::$method_name"; Carp::croak "A $method method already exists" if(defined &{$method}); } $Debug && warn "Making method: $target_class->$method_name()\n"; *{"${target_class}::$method_name"} = sub { shift; $class_invocant->get_objects( @_, return_iterator => 1, object_class => $object_class) }; } elsif($type eq 'delete') { my $method_name = $have_full_name ? $name : ($cm->auto_manager_method_name($type, $base_name, $object_class) || "delete_$name"); foreach my $class ($target_class, $class_invocant) { my $method = "${class}::$method_name"; Carp::croak "A $method method already exists" if(defined &{$method}); } $Debug && warn "Making method: $target_class->$method_name()\n"; *{"${target_class}::$method_name"} = sub { shift; $class_invocant->delete_objects(@_, object_class => $object_class); }; } elsif($type eq 'update') { my $method_name = $have_full_name ? $name : ($cm->auto_manager_method_name($type, $base_name, $object_class) || "update_$name"); foreach my $class ($target_class, $class_invocant) { my $method = "${class}::$method_name"; Carp::croak "A $method method already exists" if(defined &{$method}); } $Debug && warn "Making method: $target_class->$method_name()\n"; *{"${target_class}::$method_name"} = sub { shift; $class_invocant->update_objects(@_, object_class => $object_class); }; } else { Carp::croak "Invalid method type: $type"; } } } } sub get_objects_count { my($class) = shift; $class->get_objects(@_, count_only => 1); } sub get_objects_iterator { shift->get_objects(@_, return_iterator => 1) } sub get_objects_sql { shift->get_objects(@_, return_sql => 1) } use constant WITH => 555; # arbitrary sub get_objects { my($class, %args); if(ref $_[1]) { $class = shift; if(ref $_[0] eq 'HASH') { %args = (query => [ %{shift(@_)} ], @_); } elsif(ref $_[0] eq 'ARRAY') { %args = (query => shift, @_); } else { Carp::croak 'Invalid arguments: ', join(', ', @_) } unshift(@_, $class); # restore original args } else { ($class, %args) = @_; } $class->error(undef); my $object_class = delete $args{'object_class'} || $class->object_class || Carp::croak "Missing object class argument"; my $return_sql = delete $args{'return_sql'}; my $return_iterator = delete $args{'return_iterator'}; my $count_only = delete $args{'count_only'}; my $require_objects = delete $args{'require_objects'}; my $with_objects = delete $args{'with_objects'}; my $skip_first = delete $args{'skip_first'} || 0; my $distinct = delete $args{'distinct'}; my $fetch = delete $args{'fetch_only'}; my $hints = delete $args{'hints'} || {}; my $select = $args{'select'}; # Alias by popular demand... $args{'query'} = delete $args{'where'} if($args{'where'} && !exists $args{'query'}); $args{'strict_ops'} = $class->strict_ops unless(exists $args{'strict_ops'}); my $no_forced_sort = delete $args{'no_forced_sort'}; my $table_aliases = exists $args{'table_aliases'} ? $args{'table_aliases'} : ($args{'table_aliases'} = 1); # Coerce for_update boolean alias into lock argument if(delete $args{'for_update'}) { $args{'lock'}{'type'} ||= 'for update'; } $with_objects = undef if(ref $with_objects && !@$with_objects); $require_objects = undef if(ref $require_objects && !@$require_objects); local $Debug = $args{'debug'} if(exists $args{'debug'}); my $try_subselect_limit = (exists $args{'limit_with_subselect'}) ? $args{'limit_with_subselect'} : $class->default_limit_with_subselect; my $subselect_limit = 0; # Can't do direct inject with custom select lists my $direct_inject = $select ? 0 : delete $args{'inject_results'}; my(%fetch, %rel_name, %di_keys); my $meta = $object_class->meta; $args{'hints'} = $hints->{'t1'} || $hints->{$meta->table} || $hints; my $prepare_cached = exists $args{'prepare_cached'} ? $args{'prepare_cached'} : $class->dbi_prepare_cached; my $db = delete $args{'db'} || $object_class->init_db; my $dbh = delete $args{'dbh'}; my $dbh_retained = 0; unless($dbh) { unless($dbh = $db->retain_dbh) { $class->error($db->error); $class->handle_error($class); return undef; } $dbh_retained = 1; } # Work-around for http://rt.cpan.org//Ticket/Display.html?id=33193 local $dbh->{'pg_expand_array'} = 0 if($dbh->{'Driver'}{'Name'} eq 'Pg' && index($dbh->{'Driver'}{'Version'}, '2.0.') == 0); my $nested_joins = $args{'nested_joins'} = $db->supports_nested_joins ? (defined $args{'nested_joins'} ? $args{'nested_joins'} : $class->default_nested_joins) : 0; my $use_explicit_joins = (defined $args{'explicit_joins'}) ? $args{'explicit_joins'} : !$db->likes_implicit_joins; my $with_map_records; if($with_map_records = delete $args{'with_map_records'}) { unless(ref $with_map_records) { if($with_map_records =~ /^[A-Za-z_]\w*$/) { $with_map_records = { DEFAULT_REL_KEY() => $with_map_records }; } elsif($with_map_records) { $with_map_records = { DEFAULT_REL_KEY() => MAP_RECORD_METHOD }; } else { $with_map_records = 0; } } } my $outer_joins = ($with_objects && !$require_objects) ? 1 : 0; my($num_required_objects, %required_object, $num_with_objects, %with_objects, @belongs_to, %seen_rel, %rel_tn, %join_type); $with_objects = [ $with_objects ] if($with_objects && !ref $with_objects); $require_objects = [ $require_objects ] if($require_objects && !ref $require_objects); #print STDERR 'WITH: ', Dumper($with_objects); #print STDERR 'REQUIRE: ', Dumper($require_objects); # XXX: Currently, the most robust join-type conflict checking only # XXX: happens if a least one join-type override is present. In # XXX: other cases, the "with" wins. This is "safe" but not # XXX: necessarily efficient. # If there are any join-type overrides if(first { index($_, '!') > 0 || index($_, '?') > 0 } (($with_objects ? @$with_objects : ()), ($require_objects ? @$require_objects : ()))) { my $i = 0; my $requires_start = $with_objects ? @$with_objects : 0; my $in_require = 0; my $join_type; # Pull out the join modifiers foreach my $arg (($with_objects ? @$with_objects : ()), ($require_objects ? @$require_objects : ())) { $in_require = 1 if(!$in_require && $i++ == $requires_start); my $save_arg = $arg; $arg =~ tr/!?//d; if(index($arg, '.') < 0) { $save_arg =~ s/([!?])$//; no warnings 'uninitialized'; $join_type = ($1 eq '!' || (!$1 && $in_require)) ? 'JOIN' : 'LEFT OUTER JOIN'; Carp::croak "Conflicting suffix for '$arg' - please choose either ! or ?" if($join_type{$arg} && $join_type{$arg} ne $join_type); $join_type{$arg} = $join_type; } else { $save_arg =~ s/([!?])$//; no warnings 'uninitialized'; $join_type = ($1 eq '!' || (!$1 && $in_require)) ? 'JOIN' : 'LEFT OUTER JOIN'; Carp::croak "Conflicting suffix for '$arg' - please choose either ! or ?" if($join_type{$arg} && $join_type{$arg} ne $join_type); $join_type{$arg} = $join_type; while($save_arg =~ s/\.[^.]+$//) { $save_arg =~ s/([!?])$//; $join_type = ($1 eq '!' || (!$1 && $in_require)) ? 'JOIN' : 'LEFT OUTER JOIN'; (my $clean_arg = $save_arg) =~ tr/!?//d; Carp::croak "Conflicting suffix for '$clean_arg' - please choose either ! or ?" if($join_type{$clean_arg} && $join_type{$clean_arg} ne $join_type); $join_type{$clean_arg} = $join_type; } } } if(grep { $_ eq 'LEFT OUTER JOIN' } values %join_type) { $outer_joins = 1; } } # Putting join conditions in the WHERE clause can change the meaning of # the query when outer joins are used, so disable them in that case. my $use_redundant_join_conditions = $outer_joins ? 0 : delete $args{'redundant_join_conditions'}; #use Data::Dumper; #print STDERR 'JOIN TYPES: ', Dumper(\%join_type); #print STDERR 'POST WITH: ', Dumper($with_objects); #print STDERR 'POST REQUIRE: ', Dumper($require_objects); if($with_objects) { # Doing this implicitly is never a good idea #unless(defined $use_redundant_join_conditions) #{ # $use_redundant_join_conditions = $db->likes_redundant_join_conditions; #} # Copy argument (shallow copy) $with_objects = [ @$with_objects ]; #[ uniq @$with_objects ]; # Expand multi-level arguments if(first { index($_, '.') >= 0 } @$with_objects) { my @with_objects; foreach my $arg (@$with_objects) { next if($seen_rel{$arg}); if(index($arg, '.') < 0) { $seen_rel{$arg} = WITH; push(@with_objects, $arg); } else { my @expanded = ($arg); $seen_rel{$arg} = WITH; while($arg =~ s/\.([^.]+)$//) { next if($seen_rel{$arg}++); unshift(@expanded, $arg); } push(@with_objects, @expanded); } } $with_objects = \@with_objects; } else { $seen_rel{$_} = WITH for(@$with_objects); } $num_with_objects = @$with_objects; %with_objects = map { $_ => 1 } @$with_objects; } if($require_objects) { # Copy argument (shallow copy) $require_objects = [ @$require_objects ]; #[ uniq @$require_objects ]; # Expand multi-level arguments if(first { index($_, '.') >= 0 } @$require_objects) { my @require_objects; foreach my $arg (@$require_objects) { if(index($arg, '.') < 0) { if(my $seen = $seen_rel{$arg}) { if($seen == WITH) { Carp::croak "require_objects argument '$arg' conflicts with ", "with_objects argument of the same name"; } next; } $seen_rel{$arg}++; push(@require_objects, $arg); } else { my @expanded = ($arg); if(my $seen = $seen_rel{$arg}) { if($seen == WITH) { Carp::croak "require_objects argument '$arg' conflicts with ", "with_objects argument of the same name"; } next; } $seen_rel{$arg}++; while($arg =~ s/\.[^.]+$//) { next if($seen_rel{$arg}); unshift(@expanded, $arg); $seen_rel{$arg}++; } push(@require_objects, @expanded); } } $require_objects = \@require_objects; } else { foreach my $arg (@$require_objects) { if($seen_rel{$arg}) { Carp::croak "require_objects argument '$arg' conflicts with ", "with_objects argument of the same name"; } } } $num_required_objects = @$require_objects; %required_object = map { $_ => 1 } @$require_objects; push(@$with_objects, @$require_objects) } my %object_args = (ref $args{'object_args'} eq 'HASH') ? %{$args{'object_args'}} : (); my %subobject_args; $args{'share_db'} = 1 unless(exists $args{'share_db'}); if(delete $args{'share_db'}) { $object_args{'db'} = $db; $subobject_args{'db'} = $db; } my($fields, $fields_string, $table); $args{'nonlazy'} = [] unless(defined $args{'nonlazy'}); my $nonlazy = $args{'nonlazy'}; my %nonlazy = (ref $nonlazy ? map { $_ => 1 } @$nonlazy : ()); my @tables = ($meta->fq_table($db)); my @tables_sql = ($meta->fq_table_sql($db)); my $use_lazy_columns = (!ref $nonlazy || $nonlazy{'self'}) ? 0 : $meta->has_lazy_columns; my(%columns, %methods, %all_columns); if($use_lazy_columns) { %columns = ($tables[0] => scalar $meta->nonlazy_columns); %all_columns = ($tables[0] => scalar $meta->columns); %methods = ($tables[0] => scalar $meta->nonlazy_column_mutator_method_names); %di_keys = ($object_class => scalar $meta->nonlazy_column_db_value_hash_keys); } else { %columns = ($tables[0] => scalar $meta->columns); %methods = ($tables[0] => scalar $meta->column_mutator_method_names); %di_keys = ($object_class => scalar $meta->column_db_value_hash_keys); } my %classes = ($tables[0] => $object_class); my @classes = ($object_class); my %meta = ($object_class => $meta); my @table_names = ($meta->table); my @rel_names = ($meta->table); my(@joins, @subobject_methods, @mapped_object_methods, $clauses); my $handle_dups = 0; #my $deep_joins = 0; my @has_dups; my $manual_limit = 0; my $num_subtables = $with_objects ? @$with_objects : 0; if($distinct || $fetch) { if($fetch && ref $distinct) { Carp::croak "The 'distinct' and 'fetch' parameters cannot be used ", "together if they both contain lists of tables"; } $args{'distinct'} = 1 if($distinct); %fetch = (t1 => 1, $tables[0] => 1, $meta->table => 1); if(ref $fetch || ref $distinct) { foreach my $arg (ref $distinct ? @$distinct : @$fetch) { $fetch{$arg} = 1; } } } # Handle "page" arguments if(exists $args{'page'} || exists $args{'per_page'}) { if(exists $args{'limit'} || exists $args{'offset'}) { Carp::croak 'Cannot include the "page" or "per_page" ', 'options when the "limit" or "offset" option ', 'is used'; } my $page = delete $args{'page'} || 1; my $per_page = delete $args{'per_page'} || $class->default_objects_per_page; $page = 1 if($page < 1); $per_page = $class->default_objects_per_page if($per_page < 1); $args{'limit'} = $per_page; if($page > 1) { $args{'offset'} = ($page - 1) * $per_page; } } # Pre-process sort_by args if(my $sort_by = $args{'sort_by'}) { $sort_by = [ $sort_by ] unless(ref $sort_by eq 'ARRAY'); if($num_subtables == 0 && defined $table_aliases && $table_aliases == 0) { # trim t1. or primary table prefixes my $prefix_re = '\b(?:t1|' . $meta->table . ')\.'; $prefix_re = qr($prefix_re); foreach my $sort (@$sort_by) { $sort =~ s/$prefix_re//g unless(ref $sort); } } $args{'sort_by'} = $sort_by; } my $num_to_many_rels = 0; # Adjust for explicitly included map_record tables, which should # not count towards the multi_many_ok warning. my $num_to_many_rels_adjustment = 0; my($multi_many, @subobject_method_map); if($with_objects) { # XXX: Hack to avoid spurious ORA-00918 errors # XXX: http://ora-00918.ora-code.com/msg/28663.html if(($args{'limit'} || $args{'offset'}) && $dbh->{'Driver'}{'Name'} eq 'Oracle') { $args{'unique_aliases'} = 1; } # Copy clauses arg $clauses = $args{'clauses'} ? [ @{$args{'clauses'}} ] : []; my $i = 1; # Sanity check with_objects arguments, and determine if we're going to # have to handle duplicate data from multiple joins. If so, note # which with_objects arguments refer to relationships that may return # more than one object. foreach my $name (@$with_objects) { my $tn_name = $name; if(index($tn_name, '.') > 0) # dot at start is invalid, so "> 0" is correct { $tn_name =~ /^(.+)\.([^.]+)$/; } $rel_tn{$tn_name} = $i + 1; # note the tN table number of this relationship my $key; # Chase down multi-level keys: e.g., colors.name.types if(index($name, '.') >= 0) { #$deep_joins = 1; my $chase_meta = $meta; while($name =~ /\G([^.]+)(?:\.|$)/g) { my $sub_name = $1; $key = $chase_meta->foreign_key($sub_name) || $chase_meta->relationship($sub_name) || Carp::confess "Invalid with_objects or require_objects argument: ", "no foreign key or relationship named '$sub_name' ", 'found in ', $chase_meta->class; $chase_meta = $key->can('foreign_class') ? $key->foreign_class->meta : $key->class->meta; } } else { $key = $meta->foreign_key($name) || $meta->relationship($name) || Carp::confess "Invalid with_objects or require_objects argument: ", "no foreign key or relationship named '$name' ", "found in $class"; } my $rel_type = $key->type; if($rel_type =~ /\bmany$/) { $handle_dups = 1; $has_dups[$i] = 1; # "many to many" relationships have an extra table (the mapping table) if($rel_type eq 'many to many') { $i++; $has_dups[$i] = 1; # $num_subtables will be incremented elsewhere (below) # Adjust for explicitly included map_record tables, which should # not count towards the multi_many_ok warning. $num_to_many_rels_adjustment++; } if($args{'limit'}) { if($try_subselect_limit && $db->supports_select_from_subselect && (!$args{'offset'} || $db->supports_limit_with_offset) && !$args{'select'}) { unless($fetch && @$fetch && $fetch->[0] eq 't1') { $subselect_limit = 1; delete $args{'limit'}; delete $args{'offset'}; } } else { $manual_limit = delete $args{'limit'}; } } # This restriction seems unnecessary now #if($required_object{$name} && $num_required_objects > 1 && $num_subtables > 1) #{ # Carp::croak # qq(The "require_objects" parameter cannot be used with ), # qq(a "... to many" relationship ("$name" in this case) ), # qq(unless that relationship is the only one listed and ), # qq(the "with_objects" parameter is not used); #} } $i++; } $num_to_many_rels = grep { defined $_ } @has_dups; # Adjust for explicitly included map_record tables, which should # not count towards the multi_many_ok warning. $multi_many = (($num_to_many_rels - $num_to_many_rels_adjustment) > 1) ? 1 : 0; unless($args{'multi_many_ok'}) { if($multi_many) { Carp::carp qq(WARNING: Fetching sub-objects via more than one ), qq("one to many" relationship in a single query may ), qq(produce many redundant rows, and the query may be ), qq(slow. If you're sure you want to do this, you can ), qq(silence this warning by using the "multi_many_ok" ), qq(parameter\n); } } $i = 1; # reset iterator for second pass through with_objects # Build lists of columns, classes, methods, and join conditions for all # of the with_objects and/or require_objects arguments. foreach my $arg (@$with_objects) { my($parent_meta, $parent_tn, $name); if(index($arg, '.') > 0) # dot at start is invalid, so "> 0" is correct { $arg =~ /^(.+)\.([^.]+)$/; my $parent = $1; $name = $2; # value of $i as of last iteration $parent_tn = defined $rel_tn{$parent} ? $rel_tn{$parent}: $i; $belongs_to[$i] = $parent_tn - 1; $parent_meta = $classes[$parent_tn - 1]->meta; } else { $parent_meta = $meta; $name = $arg; $parent_tn = 1; $belongs_to[$i] = 0; } #$rel_tn{$arg} = $i + 1; # note the tN table number of this relationship my $rel = $parent_meta->foreign_key($name) || $parent_meta->relationship($name) || Carp::croak "No relationship named '$name' in class ", $parent_meta->class; my $rel_type = $rel->type; if($rel_type eq 'foreign key' || $rel_type eq 'one to one' || $rel_type eq 'many to one' || $rel_type eq 'one to many') { my $ft_class = $rel->class or Carp::confess "$class - Missing foreign object class for '$name'"; my $ft_columns = $rel->key_columns; if(!$ft_columns && $rel_type ne 'one to many') { Carp::confess "$class - Missing key columns for '$name'"; } if($rel->can('query_args') && (my $query_args = $rel->query_args)) { # (Re)map query parameters to the correct table # t1 -> No change (the primary table) # t2 -> The foreign table for(my $i = 0; $i < @$query_args; $i += 2) { my $param = $query_args->[$i]; if(ref $param) { push(@{$args{'query'}}, $param); $i--; next; } unless($param =~ s/^t2\./t$rel_tn{$arg}./) { $param = "t$rel_tn{$arg}.$param" unless($param =~ /^t\d+\./); } push(@{$args{'query'}}, $param, $query_args->[$i + 1]); } } my $ft_meta = $ft_class->meta; $meta{$ft_class} = $ft_meta; push(@tables, $ft_meta->fq_table($db)); push(@tables_sql, $ft_meta->fq_table_sql($db)); push(@rel_names, $rel_name{'t' . (scalar @tables)} = $rel->name); push(@table_names, $ft_meta->table); push(@classes, $ft_class); # Iterator will be the tN value: the first sub-table is t2, and so on $i++; my $use_lazy_columns = (!ref $nonlazy || $nonlazy{$name}) ? 0 : $ft_meta->has_lazy_columns; if($use_lazy_columns) { $columns{$tables[-1]} = $ft_meta->nonlazy_columns; $all_columns{$tables[-1]} = $ft_meta->columns; $methods{$tables[-1]} = $ft_meta->nonlazy_column_mutator_method_names; $di_keys{$classes[-1]} = $ft_meta->nonlazy_column_db_value_hash_keys; } else { $columns{$tables[-1]} = $ft_meta->columns; $methods{$tables[-1]} = $ft_meta->column_mutator_method_names; $di_keys{$classes[-1]} = $ft_meta->column_db_value_hash_keys; } $classes{$tables[-1]} = $ft_class; $subobject_methods[$i - 1] = $direct_inject ? $rel->hash_key : $rel->method_name('get_set') || $rel->method_name('get_set_now') || $rel->method_name('get_set_on_save') || Carp::confess "No 'get_set', 'get_set_now', or 'get_set_on_save' ", "method found for $rel_type '$name' in class ", $rel->parent->class; #$subobject_keys[$i - 1] = $rel->hash_key; # Reset each() iterator #keys(%$ft_columns); my(@redundant, @redundant_null); unless($ft_columns && %$ft_columns) { if($with_objects{$arg}) { $joins[$i]{'type'} = $join_type{$arg} || 'LEFT OUTER JOIN'; } elsif($use_explicit_joins) { $joins[$i]{'type'} = $join_type{$arg} || 'JOIN'; } } # Add join condition(s) while(my($local_column, $foreign_column) = each(%$ft_columns)) { # Use outer joins to handle duplicate or optional information. # Foreign keys that have all non-null columns are not outer- # joined when nested joins are enabled, however. if(!($rel_type eq 'foreign key' && $rel->is_required && $rel->referential_integrity && $nested_joins) && ($outer_joins || $with_objects{$arg})) { # Aliased table names push(@{$joins[$i]{'conditions'}}, "t${parent_tn}.$local_column = t$i.$foreign_column"); if($multi_many) { my $local_method = $parent_meta->column_mutator_method_name($local_column); my $foreign_method = $ft_meta->column_accessor_method_name($foreign_column); push(@{$subobject_method_map[$i][$belongs_to[$i - 1]]}, [ $local_method, $foreign_method ]); } # Fully-qualified table names #push(@{$joins[$i]{'conditions'}}, "$tables[0].$local_column = $tables[-1].$foreign_column"); $joins[$i]{'type'} = $join_type{$arg} || 'LEFT OUTER JOIN'; $joins[$i]{'hints'} = $hints->{"t$i"} || $hints->{$name}; # MySQL is stupid about using its indexes when "JOIN ... ON (...)" # conditions are the only ones given, so the code below adds some # redundant WHERE conditions. They should only be added when they # do not change the meaning of the query, in which case they # should nudge MySQL into using its indexes. # The clauses: "(() OR ())" # We build the two clauses separately in the loop below, then # combine it all after the loop is done. if($use_redundant_join_conditions) { # Aliased table names push(@redundant, "t${parent_tn}.$local_column = t$i.$foreign_column"); push(@redundant_null, ($has_dups[$i - 1] ? "t$i.$foreign_column IS NULL" : "t${parent_tn}.$local_column IS NULL")); # Fully-qualified table names #push(@redundant, "$tables[$parent_tn - 1].$local_column = $tables[-1].$foreign_column"); #push(@redundant_null, ($has_dups[$i - 1] ? # "$tables[-1].$foreign_column IS NULL" : # "$tables[$parent_tn - 1].$local_column IS NULL")); } } else { if($use_explicit_joins) { # Aliased table names push(@{$joins[$i]{'conditions'}}, "t${parent_tn}.$local_column = t$i.$foreign_column"); # Fully-qualified table names #push(@{$joins[$i]{'conditions'}}, "$tables[$parent_tn - 1].$local_column = $tables[-1].$foreign_column"); $joins[$i]{'type'} = $join_type{$arg} || 'JOIN'; $joins[$i]{'hints'} = $hints->{"t$i"} || $hints->{$name}; } else # implicit join with no ON clause { # Aliased table names push(@$clauses, "t${parent_tn}.$local_column = t$i.$foreign_column"); # Fully-qualified table names #push(@$clauses, "$tables[$parent_tn - 1].$local_column = $tables[-1].$foreign_column"); } } } $joins[$i]{'parent_tn'} = $parent_tn if($joins[$i] && $joins[$i]{'type'} eq 'JOIN'); # XXX: Undocumented for now... if($rel->can('join_args') && (my $join_args = $rel->join_args)) { my $cond = build_where_clause(dbh => $dbh, tables => [ @tables[$parent_tn - 1, $i - 1] ], columns => \%columns, all_columns => \%all_columns, classes => \%classes, meta => \%meta, db => $db, pretty => $Debug, query => $join_args); # XXX: Ugly hack... for($cond) { s/(?:^| )@{[ $tables[$parent_tn - 1] ]}\./t$parent_tn./mg; s/(?:^| )@{[ $tables[$i - 1] ]}\./t$i./mg; s/(?:^| )t1\./t$parent_tn./mg; s/(?:^| )t2\./t$i./mg; s/^\s\s+/ /mg; s/\A\s+//; s/\n/ /g; } push(@{$joins[$i]{'conditions'}}, $cond); } if(@redundant) { push(@$clauses, '((' . join(' AND ', @redundant) . ') OR (' . join(' OR ', @redundant_null) . '))'); } $joins[$i]{'conditions'} ||= [ '1 = 1' ] if($joins[$i]); # Add sub-object sort conditions if($rel->can('manager_args') && (my $mgr_args = $rel->manager_args)) { # Don't bother sorting by columns if we're not even selecting them if($mgr_args->{'sort_by'} && (!%fetch || ($fetch{$tables[-1]} && !$fetch{$rel_names[-1]}))) { my $sort_by = ref $mgr_args->{'sort_by'} eq 'ARRAY' ? [ @{$mgr_args->{'sort_by'}} ] : [ $mgr_args->{'sort_by'} ]; foreach my $sort (@$sort_by) { no warnings 'uninitialized'; $sort =~ s/^(['"`]?)(\w+)\1(\s+(?:ASC|DESC))?$/t$i.$1$2$1$3/i unless(ref $sort); } push(@{$args{'sort_by'}}, @$sort_by); } } } elsif($rel_type eq 'many to many') { # # First add table, columns, and clauses for the map table itself # my $map_class = $rel->map_class or Carp::confess "$class - Missing map class for '$name'"; my $map_meta = $map_class->meta; $meta{$map_class} = $map_meta; push(@tables, $map_meta->fq_table($db)); push(@tables_sql, $map_meta->fq_table_sql($db)); # %rel_name gets the foreign table (below), not the map table here push(@rel_names, $rel->name); push(@table_names, $map_meta->table); push(@classes, $map_class); my $rel_mgr_args = $rel->manager_args || {}; my $map_record_method; my $rel_map_record_method = $rel->map_record_method; if(my $rel_with_map_records = $rel_mgr_args->{'with_map_records'}) { $map_record_method = ($with_map_records && exists $with_map_records->{$name}) ? $with_map_records->{$name} : $rel_map_record_method ? $rel_map_record_method : MAP_RECORD_METHOD; } elsif($with_map_records) { $map_record_method = exists $with_map_records->{$name} ? $with_map_records->{$name} : $with_map_records->{DEFAULT_REL_KEY()} || 0; } if($map_record_method) { my $use_lazy_columns = (!ref $nonlazy || $nonlazy{$name}) ? 0 : $map_meta->has_lazy_columns; if($use_lazy_columns) { $columns{$tables[-1]} = $map_meta->nonlazy_columns; $all_columns{$tables[-1]} = $map_meta->columns; $methods{$tables[-1]} = $map_meta->nonlazy_column_mutator_method_names; $di_keys{$classes[-1]} = $map_meta->nonlazy_column_db_value_hash_keys; } else { $columns{$tables[-1]} = $map_meta->columns; $methods{$tables[-1]} = $map_meta->column_mutator_method_names; $di_keys{$classes[-1]} = $map_meta->column_db_value_hash_keys; } } else { $columns{$tables[-1]} = []; # Don't fetch map class columns $methods{$tables[-1]} = []; } $classes{$tables[-1]} = $map_class; my $column_map = $rel->column_map; # Iterator will be the tN value: the first sub-table is t2, and so on. # Increase once for map table. $i++; # Increase the tN table number of this relationship as well $rel_tn{$arg} = $i + 1; $belongs_to[$i] = $belongs_to[$i - 1]; $mapped_object_methods[$i - 1] = $map_record_method || 0; if($map_record_method) { my $ft_class = $rel->foreign_class or Carp::confess "$class - Missing foreign class for '$name'"; if($ft_class->can($map_record_method)) { if($direct_inject && (my $map_record_key = $ft_class->meta->map_record_method_key($map_record_method))) { $mapped_object_methods[$i - 1] = $map_record_key; } } else { my $map_record_key = Rose::DB::Object::Metadata::Relationship::ManyToMany::make_map_record_method( $ft_class, $map_record_method, $map_class); if($direct_inject && $mapped_object_methods[$i - 1]) { $mapped_object_methods[$i - 1] = $map_record_key; } } } # Add join condition(s) while(my($local_column, $foreign_column) = each(%$column_map)) { # Use outer joins to handle duplicate or optional information. if($outer_joins || $with_objects{$arg}) { # Aliased table names push(@{$joins[$i]{'conditions'}}, "t$i.$local_column = t${parent_tn}.$foreign_column"); # Fully-qualified table names #push(@{$joins[$i]{'conditions'}}, "$tables[-1].$local_column = $tables[$parent_tn - 1].$foreign_column"); $joins[$i]{'type'} = $join_type{$arg} || 'LEFT OUTER JOIN'; $joins[$i]{'hints'} = $hints->{"t$i"} || $hints->{$name}; } else { if($use_explicit_joins) { # Aliased table names push(@{$joins[$i]{'conditions'}}, "t$i.$local_column = t${parent_tn}.$foreign_column"); # Fully-qualified table names #push(@{$joins[$i]{'conditions'}}, "$tables[-1].$local_column = $tables[$parent_tn - 1].$foreign_column"); $joins[$i]{'type'} = $join_type{$arg} || 'JOIN'; $joins[$i]{'hints'} = $hints->{"t$i"} || $hints->{$name}; } else # implicit join with no ON clause { # Aliased table names push(@$clauses, "t$i.$local_column = t${parent_tn}.$foreign_column"); # Fully-qualified table names #push(@$clauses, "$tables[-1].$local_column = $tables[$parent_tn - 1].$foreign_column"); } } } $joins[$i]{'parent_tn'} = $parent_tn if($joins[$i] && $joins[$i]{'type'} eq 'JOIN'); # # Now add table, columns, and clauses for the foreign object # $num_subtables++; # Account for the extra table my $ft_class = $rel->foreign_class or Carp::confess "$class - Missing foreign class for '$name'"; my $ft_meta = $ft_class->meta; $meta{$ft_class} = $ft_meta; my $map_to = $rel->map_to or Carp::confess "Missing map_to value for relationship '$name' ", "in clas $class"; my $foreign_rel = $map_meta->foreign_key($map_to) || $map_meta->relationship($map_to) || Carp::confess "No foreign key or relationship named '$map_to' ", "found in $map_class"; my $ft_columns = $foreign_rel->key_columns or Carp::confess "$ft_class - Missing key columns for '$map_to'"; push(@tables, $ft_meta->fq_table($db)); push(@tables_sql, $ft_meta->fq_table_sql($db)); push(@rel_names, $rel_name{'t' . (scalar @tables)} = $rel->name); push(@table_names, $ft_meta->table); push(@classes, $ft_class); my $use_lazy_columns = (!ref $nonlazy || $nonlazy{$name}) ? 0 : $ft_meta->has_lazy_columns; if($use_lazy_columns) { $columns{$tables[-1]} = $ft_meta->nonlazy_columns; $all_columns{$tables[-1]} = $ft_meta->columns; $methods{$tables[-1]} = $ft_meta->nonlazy_column_mutator_method_names; $di_keys{$classes[-1]} = $ft_meta->nonlazy_column_db_value_hash_keys; } else { $columns{$tables[-1]} = $ft_meta->columns; $methods{$tables[-1]} = $ft_meta->column_mutator_method_names; $di_keys{$classes[-1]} = $ft_meta->column_db_value_hash_keys; } $classes{$tables[-1]} = $ft_class; # Iterator will be the tN value: the first sub-table is t2, and so on. # Increase again for foreign table. $i++; $subobject_methods[$i - 1] = $direct_inject ? $rel->hash_key : $rel->method_name('get_set') || $rel->method_name('get_set_now') || $rel->method_name('get_set_on_save') || Carp::confess "No 'get_set', 'get_set_now', or 'get_set_on_save' ", "method found for relationship '$name' in class ", "$class"; #$subobject_keys[$i - 1] = $rel->hash_key; # Reset each() iterator #keys(%$ft_columns); # Add join condition(s) while(my($local_column, $foreign_column) = each(%$ft_columns)) { # Use left joins if the map table used an outer join above if($outer_joins || $with_objects{$arg}) { # Aliased table names push(@{$joins[$i]{'conditions'}}, 't' . ($i - 1) . ".$local_column = t$i.$foreign_column"); # Fully-qualified table names #push(@{$joins[$i]{'conditions'}}, "$tables[-2].$local_column = $tables[-1].$foreign_column"); $joins[$i]{'type'} = $join_type{$arg} || 'LEFT OUTER JOIN'; $joins[$i]{'hints'} = $hints->{"t$i"} || $hints->{$name}; } else { if($use_explicit_joins) { # Aliased table names push(@{$joins[$i]{'conditions'}}, 't' . ($i - 1) . ".$local_column = t$i.$foreign_column"); # Fully-qualified table names #push(@{$joins[$i]{'conditions'}}, "$tables[-2].$local_column = $tables[-1].$foreign_column"); $joins[$i]{'type'} = $join_type{$arg} || 'JOIN'; $joins[$i]{'hints'} = $hints->{"t$i"} || $hints->{$name}; } else # implicit join with no ON clause { # Aliased table names push(@$clauses, 't' . ($i - 1) . ".$local_column = t$i.$foreign_column"); # Fully-qualified table names #push(@$clauses, "$tables[-2].$local_column = $tables[-1].$foreign_column"); } } } $joins[$i]{'parent_tn'} = $i - 1 if($joins[$i] && $joins[$i]{'type'} eq 'JOIN'); # Add sub-object sort conditions if($rel->can('manager_args') && (my $mgr_args = $rel->manager_args)) { # Don't bother sorting by columns if we're not even selecting them if($mgr_args->{'sort_by'} && (!%fetch || ($fetch{$tables[-1]} && !$fetch{$rel_names[-1]}))) { my $sort_by = ref $mgr_args->{'sort_by'} eq 'ARRAY' ? [ @{$mgr_args->{'sort_by'}} ] : [ $mgr_args->{'sort_by'} ]; # translate un-prefixed simple columns foreach my $sort (@$sort_by) { no warnings 'uninitialized'; $sort =~ s/^(['"`]?)(\w+)\1(\s+(?:ASC|DESC))?$/t$i.$1$2$1$3/i unless(ref $sort); } push(@{$args{'sort_by'}}, @$sort_by); } } } else { Carp::croak "Don't know how to auto-join relationship '$name' of type '$rel_type'"; } } $args{'clauses'} = $clauses; # restore clauses arg } # Flesh out list of fetch tables and cull columns for those tables if(%fetch) { foreach my $i (1 .. $#tables) # skip first table, which is always selected { my $tn = 't' . ($i + 1); my $rel_name = $rel_name{$tn} || ''; (my $trimmed_table = $tables[$i]) =~ s/^[^.]+\.//; unless($fetch{$tn} || $fetch{$tables[$i]} || $fetch{$trimmed_table} || $fetch{$rel_names[$i]} || $fetch{$rel_name}) { $columns{$tables[$i]} = []; $methods{$tables[$i]} = []; } } } $args{'table_map'} = { reverse %rel_tn }; my %tn; if($select) { if($fetch) { Carp::croak "The 'select' and 'fetch' parameters cannot be used together"; } $select = [ split(/\s*,\s*/, $select) ] unless(ref $select); my $i = 1; %tn = map { $_ => $i++ } @table_names; # @tables; my $expand_dotstar = 0; foreach my $item (@$select) { my($column, $tn); next if(ref $item eq 'SCALAR'); if(index($item, '.') < 0 && $item !~ /\s+ AS \s+ \w+ \s* \Z/xi) { $expand_dotstar = 1 if($item eq '*'); $column = $item; $item = "t1.$item" if($table_aliases > 0); $tn = 1; } elsif($item =~ /^t(\d+)\.(.+)$/) { $tn = $1; $item = $2 unless($table_aliases); $column = $2; $expand_dotstar = 1 if($item =~ /^t\d+\.\*$/); } elsif($item =~ /^(['"]?)([^.(]+)\1\.(['"]?)(.+)(\3)$/) { my $num = $tn{$2} || $rel_tn{$2}; $item = "t$num.$3$4$5"; $tn = $num; $column = $4; $expand_dotstar = 1 if($item =~ /^t\d+\.\*$/); } if(defined $tn) { my $meta = $meta{$classes{$tables[$tn - 1]}}; if($meta->column($column) && (my $alias = $meta->column($column)->alias)) { $item .= ' AS ' . $alias unless($alias eq $column); } } } # Expand tN.* specifiers, if necessary if($expand_dotstar) { my @select; foreach my $item (@$select) { next if(ref $item eq 'SCALAR'); unless($item =~ /^(?: t(\d+)\. )? \* $/x) { push(@select, $item); next; } my $tn = $1 || 1; my $meta = $meta{$classes{$tables[$tn - 1]}}; my $prefix = $table_aliases ? "t$tn." : ''; foreach my $column ($meta->columns) { if(my $alias = $column->alias) { push(@select, "$prefix$column AS $alias"); } else { push(@select, "$prefix$column"); } } } $select = \@select; } $args{'select'} = $select; } if($count_only) { delete $args{'limit'}; delete $args{'offset'}; delete $args{'sort_by'}; my($sql, $bind, @bind_params); # Do we have to use DISTINCT to count? my $use_distinct = $with_objects ? 1 : 0; if(!$use_distinct && $require_objects) { foreach my $name (@$require_objects) { # Ignore error here since it'll be caught and handled later anyway my $key = $meta->foreign_key($name) || $meta->relationship($name) || next; my $rel_type = $key->type; if(index($key->type, 'many') >= 0) { $use_distinct = 1; last; } } } BUILD_SQL: { my($select, $wrap); my $pk_columns = $meta->primary_key_column_names; if(!$use_distinct || @$pk_columns == 1 || $db->supports_multi_column_count_distinct) { $select = $use_distinct ? 'COUNT(DISTINCT ' . join(', ', map { "t1.$_" } @$pk_columns) . ')' : 'COUNT(*)'; } else { $select = $use_distinct ? 'DISTINCT ' . join(', ', map { "t1.$_" } @$pk_columns) : 'COUNT(*)'; $wrap = 1; } local $Carp::CarpLevel = $Carp::CarpLevel + 1; ($sql, $bind) = build_select(dbh => $dbh, select => $select, tables => \@tables, tables_sql => \@tables_sql, columns => \%columns, all_columns => \%all_columns, classes => \%classes, joins => \@joins, meta => \%meta, db => $db, pretty => $Debug, bind_params => \@bind_params, object_class => $object_class, %args); if($wrap) { $sql = "SELECT COUNT(*) FROM ($sql) sq"; } } if($return_sql) { $db->release_dbh if($dbh_retained); return wantarray ? ($sql, $bind) : $sql; } my $count = 0; my $error; TRY: { local $@; eval { local $dbh->{'RaiseError'} = 1; $Debug && warn "$sql (", join(', ', @$bind), ")\n"; my $sth = $prepare_cached ? $dbh->prepare_cached($sql, undef, 3) : $dbh->prepare($sql); if(@bind_params) { my $i = 1; foreach my $value (@$bind) { $sth->bind_param($i, $value, $bind_params[$i - 1]); $i++; } $sth->execute; } else { $sth->execute(@$bind); } ($count) = $sth->fetchrow_array; $sth->finish; }; $error = $@; } if($error) { $class->total(undef); $class->error(ref $error ? $error : "get_objects() - $error"); $class->handle_error($class); return undef; } $class->total($count); return $count; } # Post-process sort_by args if(my $sort_by = $args{'sort_by'}) { # Alter sort_by SQL, replacing table and relationship names with aliases. # This is to prevent databases like PostgreSQL from "adding missing FROM # clause"s. See: http://sql-info.de/postgresql/postgres-gotchas.html#1_5 if($table_aliases) { my $i = 0; foreach my $table (@tables) { $i++; # Table aliases are 1-based my $table_unquoted = $db->unquote_table_name($table); # Conditionalize schema part, if necessary $table_unquoted =~ s/^([^.]+\.)/(?:\Q$1\E)?/; foreach my $sort (grep { !ref } @$sort_by) { no warnings 'uninitialized'; unless($sort =~ s/^(['"`]?)(\w+)\1(\s+(?:ASC|DESC))?$/t1.$1$2$1$3/i || $sort =~ s/\b$table_unquoted\./t$i./g) { if(my $rel_name = $rel_name{"t$i"}) { $sort =~ s/\b$rel_name\./t$i./g unless($rel_name =~ /^t\d+$/); } } } } # When selecting sub-objects via a "... to many" relationship, force # a sort by t1's primary key unless sorting by some other column in # t1. This is required to ensure that all result rows from each row # in t1 are grouped together. But don't do it when we're selecting # columns from just one table. (Compare to 3 because the primary table # name, fully-qualified name, and the "t1" alias are always in the list.) if($num_to_many_rels > 0 && (!%fetch || (keys %fetch || 0) > 3) && !$no_forced_sort) { my $do_prefix = 1; foreach my $sort (@$sort_by) { if(!ref $sort && $sort =~ /^t1\./) { $do_prefix = 0; last; } } if($do_prefix) { unshift(@$sort_by, join(', ', map { "t1.$_" } $meta->primary_key_column_names)); } } } else # otherwise, trim t1. prefixes { my $prefix_re = '\b(?:t1|' . $meta->table . ')\.'; $prefix_re = qr($prefix_re); foreach my $sort (@$sort_by) { $sort =~ s/$prefix_re//g unless(ref $sort); } } # TODO: remove duplicate/redundant sort conditions $args{'sort_by'} = $sort_by; } elsif($num_to_many_rels > 0 && (!%fetch || (keys %fetch || 0) > 3) && !$no_forced_sort) { # When selecting sub-objects via a "... to many" relationship, force a # sort by t1's primary key to ensure that all result rows from each # row in t1 are grouped together. But don't do it when we're selecting # columns from just one table. (Compare to 3 because the primary table # name, fully-qualified name, and the "t1" alias are always in the list.) $args{'sort_by'} = [ join(', ', map { "t1.$_" } $meta->primary_key_column_names) ]; } if(defined $args{'offset'}) { Carp::croak "Offset argument is invalid without a limit argument" unless($args{'limit'} || $manual_limit); if($db->supports_limit_with_offset && !$manual_limit && !$subselect_limit) { $db->format_limit_with_offset($args{'limit'}, $args{'offset'}, \%args); #$args{'limit'} = $db->format_limit_with_offset($args{'limit'}, $args{'offset'}); #delete $args{'offset'}; $skip_first = 0; } elsif($manual_limit) { $skip_first += delete $args{'offset'}; } else { $skip_first += delete $args{'offset'}; $args{'limit'} += $skip_first; $db->format_limit_with_offset($args{'limit'}, undef, \%args); #$args{'limit'} = $db->format_limit_with_offset($args{'limit'}); } } elsif($args{'limit'}) { $db->format_limit_with_offset($args{'limit'}, undef, \%args); #$args{'limit'} = $db->format_limit_with_offset($args{'limit'}); } my($count, @objects, $iterator); my($sql, $bind, @bind_params); BUILD_SQL: { local $Carp::CarpLevel = $Carp::CarpLevel + 1; ($sql, $bind) = build_select(dbh => $dbh, tables => \@tables, tables_sql => \@tables_sql, columns => \%columns, all_columns => \%all_columns, classes => \%classes, joins => \@joins, meta => \%meta, db => $db, pretty => $Debug, bind_params => \@bind_params, object_class => $object_class, %args); if($subselect_limit) { my($class, %sub_args) = @_; # The sort clause is important, so it can't be deleted, but it # also can't contain references to any table but t1. if($args{'sort_by'} && $num_subtables > 0) { my @sort_by; foreach my $arg (@{$args{'sort_by'}}) { push(@sort_by, $arg) if(index((ref $arg ? $$arg : $arg), 't1.') == 0); } $sub_args{'sort_by'} = \@sort_by; } # Not safe to delete this if the query references columns in these tables #delete $sub_args{'with_objects'}; $sub_args{'fetch_only'} = [ 't1' ]; $sub_args{'from_and_where_only'} = 1; my @t1_bind_params; $sub_args{'bind_params'} = \@t1_bind_params; my($t1_sql, $t1_bind) = $class->get_objects_sql(%sub_args); my $columns = $sub_args{'select'}; unless($columns) { my $multi_table = ($sub_args{'with_objects'} && (!ref $sub_args{'with_objects'} || @{$sub_args{'with_objects'}})) || ($sub_args{'require_objects'} && (!ref $sub_args{'require_objects'} || @{$sub_args{'require_objects'}})); if($multi_table) { $table_aliases = 1; } else { $table_aliases = $multi_table unless(defined $table_aliases); } $columns = $table_aliases ? join(', ', map { "t1.$_" } @{$columns{$tables[0]}}) : join(', ', map { $_ } @{$columns{$tables[0]}}); } my $distinct = ($num_with_objects && scalar @{[ @has_dups[1 .. $num_with_objects] ]}) ? ' DISTINCT' : ''; $t1_sql = "SELECT$distinct $columns FROM\n$t1_sql"; $t1_sql =~ s/^/ /mg if($Debug); $t1_sql = $db->format_select_from_subselect($t1_sql); $sql =~ s/(\nFROM\n\s*)\S.+\s+t1\b/$1$t1_sql t1/; unshift(@$bind, @$t1_bind); if(@t1_bind_params) { unshift(@bind_params, @t1_bind_params); } } } if($return_sql) { $db->release_dbh if($dbh_retained); return wantarray ? ($sql, $bind) : $sql; } my $error; TRY: { local $@; eval { local $dbh->{'RaiseError'} = 1; $Debug && warn "$sql (", join(', ', @$bind), ")\n"; # $meta->prepare_select_options (defunct) my $sth = $prepare_cached ? $dbh->prepare_cached($sql, undef, 3) : $dbh->prepare($sql) or die $dbh->errstr; $sth->{'RaiseError'} = 1; if(@bind_params) { my $i = 1; foreach my $value (@$bind) { $sth->bind_param($i, $value, $bind_params[$i - 1]); $i++; } $sth->execute; } else { $sth->execute(@$bind); } my %row; my $col_num = 1; my $table_num = 0; if($select) { foreach my $orig_item (@$select) { my($class, $table_num, $column); my $item = (ref $orig_item eq 'SCALAR') ? $$orig_item : $orig_item; if($item =~ s/\s+AS\s+(\w.+)$//i) { $column = $1; } if(index($item, '.') < 0) { $table_num = 0; $class = $classes[$table_num]; $column ||= $item; } elsif($item =~ /^t(\d+)\.(.+)$/) { $table_num = $1 - 1; $class = $classes[$table_num]; $column ||= $2; } elsif($item =~ /^(['"]?)([^.(]+)\1\.(['"]?)(.+)\3$/) { my $table = $2; $class = $classes{$table}; $column ||= $4; my $table_num = $tn{$table} || $rel_tn{$table}; } else { $table_num = 0; $class = $classes[$table_num]; $column ||= $item; } $sth->bind_col($col_num++, \$row{$class,$table_num}{$column}); } } else { if($direct_inject) { my $driver = $db->driver || 'unknown'; foreach my $table (@tables) { my $class = $classes{$table}; my $key_map = $di_keys{$class}; foreach my $column (@{$methods{$table}}) { if($key_map->{$column} eq $column) { $sth->bind_col($col_num++, \$row{$class,$table_num}{$column}); } else # attribute uses a db-formatted key { $sth->bind_col($col_num++, \$row{$class,$table_num}{$key_map->{$column},$driver}); } } $table_num++; } } else { foreach my $table (@tables) { my $class = $classes{$table}; foreach my $column (@{$methods{$table}}) { $sth->bind_col($col_num++, \$row{$class,$table_num}{$column}); } $table_num++; } } } if($return_iterator) { $iterator = Rose::DB::Object::Iterator->new(active => 1); my $count = 0; # More trading of code duplication for performance: build custom # subroutines depending on how much work needs to be done for # each iteration. if($with_objects) { # Ug, we have to handle duplicate data due to "...to many" relationships # fetched via outer joins. if($handle_dups)# || $deep_joins) { my(@seen, %seen, @sub_objects); #my @pk_columns = $meta->primary_key_column_names; my $pk_columns = $meta->primary_key_column_names_or_aliases; # Get list of primary key columns for each sub-table my @sub_pk_columns; foreach my $i (1 .. $num_subtables) { #$sub_pk_columns[$i + 1] = [ $classes[$i]->meta->primary_key_column_names ]; $sub_pk_columns[$i + 1] = $classes[$i]->meta->primary_key_column_names_or_aliases; } my($last_object, %subobjects, %parent_objects); weaken(my $witerator = $iterator); $iterator->_next_code(sub { my($self) = shift; my $object = 0; my $object_is_ready = 0; my(@objects, $error); TRY: { local $@; eval { ROW: for(;;) { last ROW unless($sth); while($sth->fetch) { my $pk = join(PK_JOIN, map { $row{$object_class,0}{$_} } @$pk_columns); # If this is a new main (t1) table row that we haven't seen before unless($seen[0]{$pk}++) { # First, finish building the last object, if it exists if($last_object) { #$Debug && warn "Finish $object_class $last_object->{'id'}\n"; if($direct_inject) { while(my($ident, $parent) = each(%parent_objects)) { while(my($method, $subobjects) = each(%{$subobjects{$ident}})) { $parent->{$method} = $subobjects; } } } else { while(my($ident, $parent) = each(%parent_objects)) { local $parent->{STATE_LOADING()} = 1; while(my($method, $subobjects) = each(%{$subobjects{$ident}})) { $parent->$method($subobjects); } } } %subobjects = (); %parent_objects = (); # Add the object to the final list of objects that we'll return push(@objects, $last_object); $object_is_ready = 1; } #$Debug && warn "Make $object_class $pk\n"; # Now, create the object from this new main table row if($direct_inject) { $object = bless { STATE_IN_DB() => 1, %{$row{$object_class,0}}, %object_args }, $object_class; } else { $object = $object_class->new(%object_args); local $object->{STATE_LOADING()} = 1; $object->init(%{$row{$object_class,0}}); $object->{STATE_IN_DB()} = 1; } $last_object = $object; # This is the "last object" from now on @sub_objects = (); # The list of sub-objects is per-object splice(@seen, 1); # Sub-objects seen is also per-object, # so trim it, but leave the t1 table info %seen = (); # Wipe sub-object parent tracking. } $object ||= $last_object or die "Missing object for primary key '$pk'"; my $map_record; foreach my $i (1 .. $num_subtables) { my $mapped_object_method = $mapped_object_methods[$i]; next if(defined $mapped_object_method && !$mapped_object_method); my $class = $classes[$i]; my $tn = $i + 1; # Null primary key columns are not allowed my $sub_pk = join(PK_JOIN, grep { defined } map { $row{$class,$i}{$_} } @{$sub_pk_columns[$tn]}); next unless(length $sub_pk); my $subobject = $seen[$i]{$sub_pk}; unless($subobject) { # Make sub-object if($direct_inject) { $subobject = bless { STATE_IN_DB() => 1, %{$row{$class,$i}}, %subobject_args }, $class; } else { $subobject = $class->new(%subobject_args); local $subobject->{STATE_LOADING()} = 1; $subobject->init(%{$row{$class,$i}}); $subobject->{STATE_IN_DB()} = 1; } $seen[$i]{$sub_pk} = $subobject; } # If this object belongs to an attribute that can have more # than one object then just save it for later in the # per-object sub-objects list. if($has_dups[$i]) { if($mapped_object_methods[$i]) { $map_record = $subobject; } else { if($map_record) { my $method = $mapped_object_methods[$i - 1] or next; if($direct_inject) { $subobject->{$method} = $map_record; } else { local $subobject->{STATE_LOADING()} = 1; $subobject->$method($map_record); } $map_record = 0; } next if(defined $mapped_object_methods[$i]); if($has_dups[$i] && (my $bt = $belongs_to[$i])) { #$subobjects_belong_to[$i] = $#{$sub_objects[$bt]}; my $parent_object = $sub_objects[$bt]; # XXX: Special heavyweight subobject pairing in multi-many queries if($multi_many && ref $parent_object eq 'ARRAY' && @$parent_object > 1) { my $maps = $subobject_method_map[$i + 1][$bt]; my %check; foreach my $map (@$maps) { my $subobject_method = $map->[1]; $check{$subobject_method} = $subobject->$subobject_method(); } PARENT: foreach my $check_parent (reverse @$parent_object) { foreach my $map (@$maps) { my $parent_method = $map->[0]; next PARENT unless($check_parent->$parent_method() eq $check{$map->[1]}); } $parent_object = $check_parent; last PARENT; } } # XXX: This relies on parent objects coming before child # objects in the list of tables in the FROM clause. $parent_object = $parent_object->[-1] #$parent_object->[$subobjects_belong_to[$i]] if(ref $parent_object eq 'ARRAY'); my $method = $subobject_methods[$i]; my $ident = refaddr $parent_object; next if($seen{$ident,$method}{$sub_pk}++); $parent_objects{$ident} = $parent_object; push(@{$subobjects{$ident}{$method}}, $subobject); } else { my $ident = refaddr $object; my $method = $subobject_methods[$i]; next if($seen{$ident,$method}{$sub_pk}++); $parent_objects{$ident} = $object; push(@{$subobjects{$ident}{$method}}, $subobject); } push(@{$sub_objects[$i]}, $subobject); } } else # Otherwise, just assign it { $sub_objects[$i] = $subobject; my $parent_object; if(my $bt = $belongs_to[$i]) { $parent_object = $sub_objects[$bt]; # XXX: This relies on parent objects coming before # child objects in the list of tables in the FROM # clause. $parent_object = $parent_object->[-1] if(ref $parent_object eq 'ARRAY'); } else { $parent_object = $object; } my $method = $subobject_methods[$i]; # Only assign "... to one" values once next if($seen{refaddr $parent_object,$method}++); if($direct_inject) { $parent_object->{$method} = $subobject; } else { local $parent_object->{STATE_LOADING()} = 1; $parent_object->$method($subobject); } } } if($skip_first) { next ROW if($seen[0]{$pk} > 1); ++$count if($seen[0]{$pk} == 1); next ROW if($count <= $skip_first); $skip_first = 0; @objects = (); # Discard all skipped objects... $object_is_ready = 0; # ...so none are ready now next ROW; } if($object_is_ready) { $self->{'_count'}++; last ROW; } no warnings; if($manual_limit && $self->{'_count'} == $manual_limit) { $self->finish; last ROW; } } # Handle the left-over "last object" that needs to be finished and # added to the final list of objects to return. if($last_object && !$object_is_ready) { #$Debug && warn "Finish straggler $object_class $last_object->{'id'}\n"; if($direct_inject) { while(my($ident, $parent) = each(%parent_objects)) { while(my($method, $subobjects) = each(%{$subobjects{$ident}})) { $parent->{$method} = $subobjects; } } } else { while(my($ident, $parent) = each(%parent_objects)) { local $parent->{STATE_LOADING()} = 1; while(my($method, $subobjects) = each(%{$subobjects{$ident}})) { $parent->$method($subobjects); } } } push(@objects, $last_object); # Set everything up to return this object, then be done $last_object = undef; $self->{'_count'}++; $sth = undef; last ROW; } last ROW; } }; $error = $@; } if($error) { $self->error(ref $error ? $error : "next() - $error"); $class->handle_error($self); return undef; } @objects = () if($skip_first); if(@objects) { no warnings; # undef count okay if($manual_limit && $self->{'_count'} == $manual_limit) { $self->total($self->{'_count'}); $self->finish; } #$Debug && warn "Return $object_class $objects[-1]{'id'}\n"; return shift(@objects); } #$Debug && warn "Return 0\n"; return 0; }); } else # no duplicate rows to handle { $iterator->_next_code(sub { my($self) = shift; my $object = 0; my $error; TRY: { local $@; eval { ROW: for(;;) { unless($sth->fetch) { return 0; } next ROW if($skip_first && ++$count <= $skip_first); if($direct_inject) { $object = bless { STATE_IN_DB() => 1, %{$row{$object_class,0}}, %object_args }, $object_class; } else { $object = $object_class->new(%object_args); local $object->{STATE_LOADING()} = 1; $object->init(%{$row{$object_class,0}}); $object->{STATE_IN_DB()} = 1; } my @sub_objects; if($with_objects) { foreach my $i (1 .. $num_subtables) { my $method = $subobject_methods[$i]; my $class = $classes[$i]; # Skip undefined subobjects next unless(grep { defined } values %{$row{$class,$i}}); my $subobject; if($direct_inject) { $subobject = bless { STATE_IN_DB() => 1, %{$row{$class,$i}}, %subobject_args }, $class; } else { $subobject = $class->new(%subobject_args); local $subobject->{STATE_LOADING()} = 1; $subobject->init(%{$row{$class,$i}}); $subobject->{STATE_IN_DB()} = 1; } $sub_objects[$i] = $subobject; if($direct_inject) { if(my $bt = $belongs_to[$i]) { $sub_objects[$bt]->{$method} = $subobject; } else { $object->{$method} = $subobject; } } else { if(my $bt = $belongs_to[$i]) { local $sub_objects[$bt]->{STATE_LOADING()} = 1; $sub_objects[$bt]->$method($subobject); } else { local $object->{STATE_LOADING()} = 1; $object->$method($subobject); } } } } $skip_first = 0; $self->{'_count'}++; last ROW; } }; $error = $@; } if($error) { $self->error(ref $error ? $error : "next() - $error"); $class->handle_error($self); return undef; } return $skip_first ? undef : $object; }); } } else # no sub-objects at all { $iterator->_next_code(sub { my($self) = shift; my $object = 0; my $error; TRY: { local $@; eval { ROW: for(;;) { unless($sth->fetch) { #$self->total($self->{'_count'}); return 0; } next ROW if($skip_first && ++$count <= $skip_first); if($direct_inject) { $object = bless { STATE_IN_DB() => 1, %{$row{$object_class,0}}, %object_args }, $object_class; } else { $object = $object_class->new(%object_args); local $object->{STATE_LOADING()} = 1; $object->init(%{$row{$object_class,0}}); $object->{STATE_IN_DB()} = 1; } $skip_first = 0; $self->{'_count'}++; last ROW; } }; $error = $@; } if($error) { $self->error(ref $error ? $error : "next() - $error"); $class->handle_error($self); return undef; } return $object; }); } $iterator->_finish_code(sub { $sth->finish if($sth); $db->release_dbh if($db && $dbh_retained); $sth = undef; $db = undef; }); $iterator->_destroy_code(sub { $db->release_dbh if($db && $dbh_retained); $sth = undef; $db = undef; }); return $iterator; } $count = 0; if($with_objects) { # This "if" clause is a totally separate code path for handling # duplicates rows. I'm doing this for performance reasons. if($handle_dups)# || $deep_joins) { my(@seen, %seen, @sub_objects); #my @pk_columns = $meta->primary_key_column_names; my $pk_columns = $meta->primary_key_column_names_or_aliases; # Get list of primary key columns for each sub-table my @sub_pk_columns; foreach my $i (1 .. $num_subtables) { #$sub_pk_columns[$i + 1] = [ $classes[$i]->meta->primary_key_column_names ]; $sub_pk_columns[$i + 1] = $classes[$i]->meta->primary_key_column_names_or_aliases; } my($last_object, %subobjects, %parent_objects); ROW: while($sth->fetch) { my $pk = join(PK_JOIN, map { $row{$object_class,0}{$_} } @$pk_columns); my $object; # If this is a new main (t1) table row that we haven't seen before unless($seen[0]{$pk}++) { # First, finish building the last object, if it exists if($last_object) { if($direct_inject) { while(my($ident, $parent) = each(%parent_objects)) { while(my($method, $subobjects) = each(%{$subobjects{$ident}})) { $parent->{$method} = $subobjects; # XXX } } } else { while(my($ident, $parent) = each(%parent_objects)) { local $parent->{STATE_LOADING()} = 1; while(my($method, $subobjects) = each(%{$subobjects{$ident}})) { $parent->$method($subobjects); } } } %subobjects = (); %parent_objects = (); # Add the object to the final list of objects that we'll return push(@objects, $last_object); if(!$skip_first && $manual_limit && @objects == $manual_limit) { last ROW; } } # Now, create the object from this new main table row if($direct_inject) { $object = bless { STATE_IN_DB() => 1, %{$row{$object_class,0}}, %object_args }, $object_class; } else { $object = $object_class->new(%object_args); local $object->{STATE_LOADING()} = 1; $object->init(%{$row{$object_class,0}}); $object->{STATE_IN_DB()} = 1; } $last_object = $object; # This is the "last object" from now on. @sub_objects = (); # The list of sub-objects is per-object. splice(@seen, 1); # Sub-objects seen is also per-object, # so trim it, but leave the t1 table info. %seen = (); # Wipe sub-object parent tracking. } $object ||= $last_object or die "Missing object for primary key '$pk'"; my $map_record; foreach my $i (1 .. $num_subtables) { my $mapped_object_method = $mapped_object_methods[$i]; next if(defined $mapped_object_method && !$mapped_object_method); my $class = $classes[$i]; my $tn = $i + 1; # Null primary key columns are not allowed my $sub_pk = join(PK_JOIN, grep { defined } map { $row{$class,$i}{$_} } @{$sub_pk_columns[$tn]}); next unless(length $sub_pk); my $subobject = $seen[$i]{$sub_pk}; unless($subobject) { # Make sub-object if($direct_inject) { $subobject = bless { STATE_IN_DB() => 1, %{$row{$class,$i}}, %subobject_args }, $class; } else { $subobject = $class->new(%subobject_args); local $subobject->{STATE_LOADING()} = 1; $subobject->init(%{$row{$class,$i}}); $subobject->{STATE_IN_DB()} = 1; } $seen[$i]{$sub_pk} = $subobject; } # If this object belongs to an attribute that can have more # than one object then just save it for later in the # per-object sub-objects list. if($has_dups[$i]) { if($mapped_object_method) { $map_record = $subobject; } else { if($map_record) { my $method = $mapped_object_methods[$i - 1] or next; if($direct_inject) { $subobject->{$method} = $map_record; } else { local $subobject->{STATE_LOADING()} = 1; $subobject->$method($map_record); } $map_record = 0; } next if(defined $mapped_object_methods[$i]); if($has_dups[$i] && (my $bt = $belongs_to[$i])) { #$subobjects_belong_to[$i] = $#{$sub_objects[$bt]}; my $parent_object = $sub_objects[$bt]; # XXX: Special heavyweight subobject pairing in multi-many queries if($multi_many && ref $parent_object eq 'ARRAY' && @$parent_object > 1) { my $maps = $subobject_method_map[$i + 1][$bt]; my %check; foreach my $map (@$maps) { my $subobject_method = $map->[1]; $check{$subobject_method} = $subobject->$subobject_method(); } PARENT: foreach my $check_parent (reverse @$parent_object) { foreach my $map (@$maps) { my $parent_method = $map->[0]; next PARENT unless($check_parent->$parent_method() eq $check{$map->[1]}); } $parent_object = $check_parent; last PARENT; } } # XXX: This relies on parent objects coming before child # objects in the list of tables in the FROM clause. $parent_object = $parent_object->[-1] #$parent_object->[$subobjects_belong_to[$i]] if(ref $parent_object eq 'ARRAY'); my $method = $subobject_methods[$i]; my $ident = refaddr $parent_object; next if($seen{$ident,$method}{$sub_pk}++); $parent_objects{$ident} = $parent_object; push(@{$subobjects{$ident}{$method}}, $subobject); } else { my $ident = refaddr $object; my $method = $subobject_methods[$i]; next if($seen{$ident,$method}{$sub_pk}++); $parent_objects{$ident} = $object; push(@{$subobjects{$ident}{$method}}, $subobject); } push(@{$sub_objects[$i]}, $subobject); } } else # Otherwise, just assign it { push(@{$sub_objects[$i]}, $subobject); my $parent_object; if(my $bt = $belongs_to[$i]) { $parent_object = $sub_objects[$bt]; # XXX: This relies on parent objects coming before child # objects in the list of tables in the FROM clause. $parent_object = $parent_object->[-1] if(ref $parent_object eq 'ARRAY'); } else { $parent_object = $object; } my $method = $subobject_methods[$i]; # Only assign "... to one" values once next if($seen{refaddr $parent_object,$method}++); if($direct_inject) { $parent_object->{$method} = $subobject; } else { local $parent_object->{STATE_LOADING()} = 1; $parent_object->$method($subobject); } } } if($skip_first) { next ROW if($seen[0]{$pk} > 1); next ROW if(@objects < $skip_first); $skip_first = 0; @objects = (); # Discard all skipped objects next ROW; } } # Handle the left-over "last object" that needs to be finished and # added to the final list of objects to return. if($last_object && !$skip_first) { if($direct_inject) { while(my($ident, $parent) = each(%parent_objects)) { while(my($method, $subobjects) = each(%{$subobjects{$ident}})) { $parent->{$method} = $subobjects; # XXX } } } else { while(my($ident, $parent) = each(%parent_objects)) { local $parent->{STATE_LOADING()} = 1; while(my($method, $subobjects) = each(%{$subobjects{$ident}})) { $parent->$method($subobjects); } } } unless($manual_limit && @objects >= $manual_limit) { push(@objects, $last_object); } } @objects = () if($skip_first); } else # simple sub-objects case: nothing worse than one-to-one relationships { if($skip_first) { while($sth->fetch) { next if(++$count < $skip_first); last; } } while($sth->fetch) { my $object; if($direct_inject) { $object = bless { STATE_IN_DB() => 1, %{$row{$object_class,0}}, %object_args }, $object_class; } else { $object = $object_class->new(%object_args); local $object->{STATE_LOADING()} = 1; $object->init(%{$row{$object_class,0}}); $object->{STATE_IN_DB()} = 1; } my @sub_objects; foreach my $i (1 .. $num_subtables) { my $method = $subobject_methods[$i]; my $class = $classes[$i]; # Skip undefined subobjects next unless(grep { defined } values %{$row{$class,$i}}); my $subobject; if($direct_inject) { $subobject = bless { STATE_IN_DB() => 1, %{$row{$class,$i}}, %subobject_args }, $class; } else { $subobject = $class->new(%subobject_args); local $subobject->{STATE_LOADING()} = 1; $subobject->init(%{$row{$class,$i}}); $subobject->{STATE_IN_DB()} = 1; } $sub_objects[$i] = $subobject; if($direct_inject) { if(my $bt = $belongs_to[$i]) { $sub_objects[$bt]->{$method} = $subobject; } else { $object->{$method} = $subobject; } } else { if(my $bt = $belongs_to[$i]) { local $sub_objects[$bt]->{STATE_LOADING()} = 1; $sub_objects[$bt]->$method($subobject); } else { local $object->{STATE_LOADING()} = 1; $object->$method($subobject); } } } push(@objects, $object); } } } else # even simpler: no sub-objects at all { if($skip_first) { while($sth->fetch) { next if(++$count < $skip_first); last; } } if($direct_inject) { my $key_map = $di_keys{$object_class}; while($sth->fetch) { push(@objects, bless { STATE_IN_DB() => 1, %{$row{$object_class,0}}, %object_args }, $object_class); } } else { while($sth->fetch) { my $object = $object_class->new(%object_args); local $object->{STATE_LOADING()} = 1; $object->init(%{$row{$object_class,0}}); $object->{STATE_IN_DB()} = 1; push(@objects, $object); } } } $sth->finish; }; $error = $@; } return $iterator if($iterator); $db->release_dbh if($dbh_retained); if($error) { $class->error(ref $error ? $error : "get_objects() - $error"); $class->handle_error($class); return undef; } return \@objects; } sub _map_action { my($class, $action, @objects) = @_; $class->error(undef); foreach my $object (@objects) { unless($object->$action()) { $class->error($object->error); $class->handle_error($class); return; } } return 1; } sub save_objects { shift->_map_action('save', @_) } sub delete_objects { my($class, %args); if(ref $_[1]) { $class = shift; if(ref $_[0] eq 'HASH') { %args = (where => [ %{shift(@_)} ], @_); } elsif(ref $_[0] eq 'ARRAY') { %args = (where => shift, @_); } else { Carp::croak 'Invalid arguments: ', join(', ', @_) } unshift(@_, $class); # restore original args } else { ($class, %args) = @_; } $class->error(undef); my $object_class = $args{'object_class'} || $class->object_class or Carp::croak "Missing object class argument"; my $meta = $object_class->meta; my $prepare_cached = exists $args{'prepare_cached'} ? $args{'prepare_cached'} : $class->dbi_prepare_cached; my $db = $args{'db'} ||= $object_class->init_db; my $dbh = $args{'dbh'}; my $dbh_retained = 0; unless($dbh) { unless($dbh = $db->retain_dbh) { $class->error($db->error); $class->handle_error($class); return undef; } $args{'dbh'} = $dbh; $dbh_retained = 1; } $args{'query'} = delete $args{'where'}; unless(($args{'query'} && @{$args{'query'}}) || ($args{'clauses'} && @{$args{'clauses'}}) || delete $args{'all'}) { Carp::croak "$class - Refusing to delete all rows from the table '", $meta->fq_table($db), "' without an explict ", "'all => 1' parameter. (No 'where' or 'clauses' parameters ", "were passed to limit the scope of the delete operation.)"; } if($args{'query'} && @{$args{'query'}} && $args{'all'}) { Carp::croak "Illegal use of the 'where' and 'all' parameters in the same call"; } # Yes, I'm re-using get_objects() code like crazy, and often # in weird ways. Shhhh, it's a secret. my @bind_params; $args{'bind_params'} = \@bind_params; # Avert your eyes... my($where, $bind) = $class->get_objects(%args, return_sql => 1, where_only => 1, table_aliases => undef); my $sql = 'DELETE FROM ' . $meta->fq_table_sql($db) . ($where ? " WHERE\n$where" : ''); my($count, $error); TRY: { local $@; eval { local $dbh->{'RaiseError'} = 1; $Debug && warn "$sql - bind params: ", join(', ', @$bind), "\n"; # $meta->prepare_bulk_delete_options (defunct) my $sth = $prepare_cached ? $dbh->prepare_cached($sql, undef, 3) : $dbh->prepare($sql) or die $dbh->errstr; if(@bind_params) { my $i = 1; foreach my $value (@$bind) { $sth->bind_param($i, $value, $bind_params[$i - 1]); $i++; } $sth->execute; } else { $sth->execute(@$bind); } $count = $sth->rows || 0; }; $error = $@; } if($error) { $class->error(ref $error ? $error : "delete_objects() - $error"); $class->handle_error($class); return undef; } return $count; } sub update_objects { my($class, %args) = @_; $class->error(undef); my $object_class = $args{'object_class'} || $class->object_class or Carp::croak "Missing object class argument"; my $meta = $object_class->meta; my $prepare_cached = exists $args{'prepare_cached'} ? $args{'prepare_cached'} : $class->dbi_prepare_cached; my $db = $args{'db'} ||= $object_class->init_db; my $dbh = $args{'dbh'}; my $dbh_retained = 0; unless($dbh) { unless($dbh = $db->retain_dbh) { $class->error($db->error); $class->handle_error($class); return undef; } $args{'dbh'} = $dbh; $dbh_retained = 1; } unless(($args{'where'} && @{$args{'where'}}) || delete $args{'all'}) { Carp::croak "$class - Refusing to update all rows in the table '", $meta->fq_table_sql($db), "' without an explict ", "'all => 1' parameter"; } if($args{'where'} && @{$args{'where'}} && $args{'all'}) { Carp::croak "Illegal use of the 'where' and 'all' parameters in the same call"; } my $where = delete $args{'where'}; my $set = delete $args{'set'} or Carp::croak "Missing requires 'set' parameter"; $set = [ %$set ] if(ref $set eq 'HASH'); # Yes, I'm re-using get_objects() code like crazy, and often # in weird ways. Shhhh, it's a secret. my @bind_params; $args{'bind_params'} = \@bind_params; $args{'query'} = $set; # Avert your eyes... my($set_sql, $set_bind) = $class->get_objects(%args, return_sql => 1, where_only => 1, logic => ',', set => 1, table_aliases => 0); my $sql; my $where_bind = []; if($args{'query'} = $where) { my $where_sql; ($where_sql, $where_bind) = $class->get_objects(%args, return_sql => 1, where_only => 1, table_aliases => 0); $sql = 'UPDATE ' . $meta->fq_table_sql($db) . "\nSET\n$set_sql\nWHERE\n$where_sql"; } else { $sql = 'UPDATE ' . $meta->fq_table_sql($db) . "\nSET\n$set_sql"; } my($count, $error); TRY: { local $@; eval { local $dbh->{'RaiseError'} = 1; $Debug && warn "$sql (", join(', ', @$set_bind, @$where_bind), ")\n"; # $meta->prepare_bulk_update_options (defunct) my $sth = $prepare_cached ? $dbh->prepare_cached($sql, undef, 3) : $dbh->prepare($sql) or die $dbh->errstr; if(@bind_params) { my $i = 1; foreach my $value (@$set_bind, @$where_bind) { $sth->bind_param($i, $value, $bind_params[$i - 1]); $i++; } $sth->execute; } else { $sth->execute(@$set_bind, @$where_bind); } $count = $sth->rows || 0; }; $error = $@; } if($error) { $class->error(ref $error ? $error : "update_objects() - $error"); $class->handle_error($class); return undef; } return $count; } sub make_manager_method_from_sql { my($class) = shift; my %args; if(@_ == 2) { %args = (method => $_[0], sql => $_[1]); } else { %args = @_ } my $named_args = delete $args{'params'}; my $method = delete $args{'method'} or Carp::croak "Missing method name"; my $code; $args{'_methods'} = {}; # Will fill in on first run my $worker_method = $args{'iterator'} ? 'get_objects_iterator_from_sql' : 'get_objects_from_sql'; if($named_args) { my @params = @$named_args; # every little bit counts $code = sub { my($self, %margs) = @_; $self->$worker_method( %args, args => [ delete @margs{@params} ], %margs); }; } else { $code = sub { shift->$worker_method(%args, args => \@_) }; } no strict 'refs'; *{"${class}::$method"} = $code; return $code; } sub get_objects_from_sql { my($class) = shift; my(%args, $sql); if(@_ == 1) { $sql = shift } else { %args = @_; $sql = $args{'sql'}; } Carp::croak "Missing SQL" unless($sql); my $object_class = $args{'object_class'} || $class->object_class || Carp::croak "Missing object class"; my $meta = $object_class->meta or Carp::croak "Could not get meta for $object_class"; my $prepare_cached = exists $args{'prepare_cached'} ? $args{'prepare_cached'} : $class->dbi_prepare_cached; my $methods = $args{'_methods'}; my $exec_args = $args{'args'} || []; my $have_methods = ($args{'_methods'} && %{$args{'_methods'}}) ? 1 : 0; my $db = delete $args{'db'} || $object_class->init_db; my $dbh = delete $args{'dbh'}; my $dbh_retained = 0; unless($dbh) { unless($dbh = $db->retain_dbh) { $class->error($db->error); $class->handle_error($class); return undef; } $dbh_retained = 1; } my %object_args = ( (exists $args{'share_db'} ? $args{'share_db'} : 1) ? (db => $db) : () ); my(@objects, $error); TRY: { local $@; eval { local $dbh->{'RaiseError'} = 1; $Debug && warn "$sql (", join(', ', @$exec_args), ")\n"; my $sth = $prepare_cached ? $dbh->prepare_cached($sql, undef, 3) : $dbh->prepare($sql) or die $dbh->errstr; $sth->execute(@$exec_args); while(my $row = $sth->fetchrow_hashref) { unless($have_methods) { foreach my $col (keys %$row) { if($meta->column($col)) { $methods->{$col} = $meta->column_mutator_method_name($col); } elsif($object_class->can($col)) { $methods->{$col} = $col; } elsif($meta->column(lc $col)) { $methods->{$col} = $meta->column_mutator_method_name(lc $col); } elsif($object_class->can(lc $col)) { $methods->{$col} = lc $col; } } $have_methods = 1; } my $object = $object_class->new(%object_args); local $object->{STATE_LOADING()} = 1; $object->{STATE_IN_DB()} = 1; while(my($col, $val) = each(%$row)) { my $method = $methods->{$col} || $col; $object->$method($val); } $object->{MODIFIED_COLUMNS()} = {}; push(@objects, $object); } }; $error = $@; } $db->release_dbh if($dbh_retained); if($error) { $class->total(undef); $class->error(ref $error ? $error : "get_objects_from_sql() - $error"); $class->handle_error($class); return undef; } return \@objects; } sub get_objects_iterator_from_sql { my($class) = shift; my(%args, $sql); if(@_ == 1) { $sql = shift } else { %args = @_; $sql = $args{'sql'}; } Carp::croak "Missing SQL" unless($sql); my $object_class = $args{'object_class'} || $class->object_class || Carp::croak "Missing object class"; weaken(my $meta = $object_class->meta or Carp::croak "Could not get meta for $object_class"); my $prepare_cached = exists $args{'prepare_cached'} ? $args{'prepare_cached'} : $class->dbi_prepare_cached; my $methods = $args{'_methods'}; my $exec_args = $args{'args'} || []; my $have_methods = ($args{'_methods'} && %{$args{'_methods'}}) ? 1 : 0; my $db = delete $args{'db'} || $object_class->init_db; my $dbh = delete $args{'dbh'}; my $dbh_retained = 0; unless($dbh) { unless($dbh = $db->retain_dbh) { $class->error($db->error); $class->handle_error($class); return undef; } $dbh_retained = 1; } my %object_args = ( (exists $args{'share_db'} ? $args{'share_db'} : 1) ? (db => $db) : () ); my($sth, $error); TRY: { local $@; eval { local $dbh->{'RaiseError'} = 1; $Debug && warn "$sql (", join(', ', @$exec_args), ")\n"; $sth = $prepare_cached ? $dbh->prepare_cached($sql, undef, 3) : $dbh->prepare($sql) or die $dbh->errstr; $sth->execute(@$exec_args); }; $error = $@; } if($error) { $db->release_dbh if($dbh_retained); $class->total(undef); $class->error(ref $error ? $error : "get_objects_iterator_from_sql() - $error"); $class->handle_error($class); return undef; } my $iterator = Rose::DB::Object::Iterator->new(active => 1); $iterator->_next_code(sub { my($self) = shift; my $object = 0; my $error; TRY: { local $@; eval { ROW: for(;;) { my $row = $sth->fetchrow_hashref or return 0; unless($have_methods) { foreach my $col (keys %$row) { if($meta->column($col)) { $methods->{$col} = $meta->column_mutator_method_name($col); } elsif($object_class->can($col)) { $methods->{$col} = $col; } elsif($meta->column(lc $col)) { $methods->{$col} = $meta->column_mutator_method_name(lc $col); } elsif($object_class->can(lc $col)) { $methods->{$col} = lc $col; } } $have_methods = 1; } $object = $object_class->new(%object_args); local $object->{STATE_LOADING()} = 1; $object->{STATE_IN_DB()} = 1; while(my($col, $val) = each(%$row)) { my $method = $methods->{$col}; $object->$method($val); } $object->{MODIFIED_COLUMNS()} = {}; $self->{'_count'}++; last ROW; } }; $error = $@; } if($error) { $self->error(ref $error ? $error : "next() - $error"); $class->handle_error($self); return undef; } return $object; }); $iterator->_finish_code(sub { $sth->finish if($sth); $db->release_dbh if($db && $dbh_retained); $sth = undef; $db = undef; }); $iterator->_destroy_code(sub { $db->release_dbh if($db && $dbh_retained); $sth = undef; $db = undef; }); return $iterator; } sub perl_class_definition { my($class) = shift; my $object_class = $class->object_class || $class->_object_class; no strict 'refs'; my @isa = @{"${class}::ISA"}; my $use_bases = "use base qw(@isa);"; return<<"EOF"; package $class; use strict; $use_bases use $object_class; sub object_class { '@{[ $class->object_class || $class->_object_class ]}' } __PACKAGE__->make_manager_methods('@{[ $class->_base_name ]}'); 1; EOF } 1; __END__ =head1 NAME Rose::DB::Object::Manager - Fetch multiple Rose::DB::Object-derived objects from the database using complex queries. =head1 SYNOPSIS ## ## Given the following Rose::DB::Object-derived classes... ## package Category; use base 'Rose::DB::Object'; __PACKAGE__->meta->setup ( table => 'categories', columns => [ id => { type => 'int', primary_key => 1 }, name => { type => 'varchar', length => 255 }, description => { type => 'text' }, ], unique_key => 'name', ); ... package CodeName; use base 'Rose::DB::Object'; __PACKAGE__->meta->setup ( table => 'code_names', columns => [ id => { type => 'int', primary_key => 1 }, product_id => { type => 'int' }, name => { type => 'varchar', length => 255 }, applied => { type => 'date', not_null => 1 }, ], foreign_keys => [ product => { class => 'Product', key_columns => { product_id => 'id' }, }, ], ); ... package Product; use base 'Rose::DB::Object'; __PACKAGE__->meta->setup ( table => 'products', columns => [ id => { type => 'int', primary_key => 1 }, name => { type => 'varchar', length => 255 }, description => { type => 'text' }, category_id => { type => 'int' }, region_num => { type => 'int' }, status => { type => 'varchar', check_in => [ 'active', 'inactive' ], default => 'inactive', }, start_date => { type => 'datetime' }, end_date => { type => 'datetime' }, date_created => { type => 'timestamp', default => 'now' }, last_modified => { type => 'timestamp', default => 'now' }, ], unique_key => 'name', foreign_keys => [ category => { class => 'Category', key_columns => { category_id => 'id', } }, ], relationships => [ code_names => { type => 'one to many', class => 'CodeName', column_map => { id => 'product_id' }, manager_args => { sort_by => CodeName->meta->table . '.applied DESC', }, }, ], ); ... ## ## Create a manager class ## package Product::Manager; use base 'Rose::DB::Object::Manager'; sub object_class { 'Product' } __PACKAGE__->make_manager_methods('products'); # The call above creates the methods shown below. (The actual # method bodies vary slightly, but this is the gist of it...) # # sub get_products # { # shift->get_objects(@_, object_class => 'Product'); # } # # sub get_products_iterator # { # shift->get_objects_iterator(@_, object_class => 'Product'); # } # # sub get_products_count # { # shift->get_objects_count(@_, object_class => 'Product'); # } # # sub update_products # { # shift->update_objects(@_, object_class => 'Product'); # } # # sub delete_products # { # shift->delete_objects(@_, object_class => 'Product'); # } ... ## ## Use the manager class ## # # Get a reference to an array of objects # $products = Product::Manager->get_products ( query => [ category_id => [ 5, 7, 22 ], status => 'active', start_date => { lt => '15/12/2005 6:30 p.m.' }, name => { like => [ '%foo%', '%bar%' ] }, ], sort_by => 'category_id, start_date DESC', limit => 100, offset => 80, ); foreach my $product (@$products) { print $product->id, ' ', $product->name, "\n"; } # # Get objects iterator # $iterator = Product::Manager->get_products_iterator ( query => [ category_id => [ 5, 7, 22 ], status => 'active', start_date => { lt => '15/12/2005 6:30 p.m.' }, name => { like => [ '%foo%', '%bar%' ] }, ], sort_by => 'category_id, start_date DESC', limit => 100, offset => 80, ); while($product = $iterator->next) { print $product->id, ' ', $product->name, "\n"; } print $iterator->total; # # Get objects count # $count = Product::Manager->get_products_count ( query => [ category_id => [ 5, 7, 22 ], status => 'active', start_date => { lt => '15/12/2005 6:30 p.m.' }, name => { like => [ '%foo%', '%bar%' ] }, ], ); die Product::Manager->error unless(defined $count); print $count; # or Product::Manager->total() # # Get objects and sub-objects in a single query # $products = Product::Manager->get_products ( with_objects => [ 'category', 'code_names' ], query => [ category_id => [ 5, 7, 22 ], status => 'active', start_date => { lt => '15/12/2005 6:30 p.m.' }, # We need to disambiguate the "name" column below since it # appears in more than one table referenced by this query. # When more than one table is queried, the tables have numbered # aliases starting from the "main" table ("products"). The # "products" table is t1, "categories" is t2, and "code_names" # is t3. You can read more about automatic table aliasing in # the documentation for the get_objects() method below. # # "category.name" and "categories.name" would work too, since # table and relationship names are also valid prefixes. 't2.name' => { like => [ '%foo%', '%bar%' ] }, ], sort_by => 'category_id, start_date DESC', limit => 100, offset => 80, ); foreach my $product (@$products) { # The call to $product->category does not hit the database print $product->name, ': ', $product->category->name, "\n"; # The call to $product->code_names does not hit the database foreach my $code_name ($product->code_names) { # This call doesn't hit the database either print $code_name->name, "\n"; } } # # Update objects # $num_rows_updated = Product::Manager->update_products( set => { end_date => DateTime->now, region_num => { sql => 'region_num * -1' } status => 'defunct', }, where => [ start_date => { lt => '1/1/1980' }, status => [ 'active', 'pending' ], ]); # # Delete objects # $num_rows_deleted = Product::Manager->delete_products( where => [ status => [ 'stale', 'old' ], name => { like => 'Wax%' }, or => [ start_date => { gt => '2008-12-30' }, end_date => { gt => 'now' }, ], ]); =head1 DESCRIPTION L is a base class for classes that select rows from tables fronted by L-derived classes. Each row in the table(s) queried is converted into the equivalent L-derived object. Class methods are provided for fetching objects all at once, one at a time through the use of an iterator, or just getting the object count. Subclasses are expected to create syntactically pleasing wrappers for L class methods, either manually or with the L method. A very minimal example is shown in the L above. =head1 CLASS METHODS =over 4 =item B Get or set a boolean value that indicates whether or not this class will use L's L method by default (instead of the L method) when preparing SQL queries. The default value is false. =item B Get or set a boolean value that determines whether or not this class will consider using a sub-query to express C/C constraints when fetching sub-objects related through one of the "...-to-many" relationship types. Not all databases support this syntax, and not all queries can use it even in supported databases. If this parameter is true, the feature will be used when possible, by default. The default value is true. =item B Get or set the default list of method types used by the L method. The default list is C, C, C, C, and C. =item B Get or set a boolean value that determines whether or not this class will consider using nested JOIN syntax when fetching related objects. Not all databases support this syntax, and not all queries can use it even in supported databases. If this parameter is true, the feature will be used when possible, by default. The default value is true. =item B Get or set the default number of items per page, as returned by the L method when used with the C and/or C parameters. The default value is 20. =item B Delete rows from a table fronted by a L-derived class based on PARAMS, where PARAMS are name/value pairs. Returns the number of rows deleted, or undef if there was an error. If the first argument is a reference to a hash or array, it is converted to a reference to an array (if necessary) and taken as the value of the C parameter. Valid parameters are: =over 4 =item B If set to a true value, this parameter indicates an explicit request to delete all rows from the table. If both the C and the C parameters are passed, a fatal error will occur. =item B A L-derived object used to access the database. If omitted, one will be created by calling the L method of the L. =item B If true, then L's L method will be used (instead of the L method) when preparing the SQL statement that will delete the objects. If omitted, the default value is determined by the L class method. =item B The name of the L-derived class that fronts the table from which rows are to be deleted. This parameter is required; a fatal error will occur if it is omitted. Defaults to the value returned by the L class method. =item B The query parameters, passed as a reference to an array of name/value pairs. These pairs are used to formulate the "where" clause of the SQL query that is used to delete the rows from the table. Arbitrarily nested boolean logic is supported. For the complete list of valid parameter names and values, see the documentation for the C parameter of the L function in the L module. If this parameter is omitted, this method will refuse to delete all rows from the table and a fatal error will occur. To delete all rows from a table, you must pass the C parameter with a true value. If both the C and the C parameters are passed, a fatal error will occur. =back =item B Returns the text message associated with the last error, or false if there was no error. =item B Get or set the error mode for this class. The error mode determines what happens when a method of this class encounters an error. The default setting is "fatal", which means that methods will L if they encounter an error. B The error return values described in the method documentation in the rest of this document are only relevant when the error mode is set to something "non-fatal." In other words, if an error occurs, you'll never see any of those return values if the selected error mode Ls or Ls or otherwise throws an exception when an error occurs. Valid values of MODE are: =over 4 =item carp Call L with the value of the object L as an argument. =item cluck Call L with the value of the object L as an argument. =item confess Call L with the value of the object L as an argument. =item croak Call L with the value of the object L as an argument. =item fatal An alias for the "croak" mode. =item return Return a value that indicates that an error has occurred, as described in the documentation for each method. =back In all cases, the class's C attribute will also contain the error message. =item B Get L-derived objects based on PARAMS, where PARAMS are name/value pairs. Returns a reference to a (possibly empty) array, or undef if there was an error. If the first argument is a reference to a hash or array, it is converted to a reference to an array (if necessary) and taken as the value of the C parameter. Each table that participates in the query will be aliased. Each alias is in the form "tN" where "N" is an ascending number starting with 1. The tables are numbered as follows. =over 4 =item * The primary table is always "t1" =item * The table(s) that correspond to each relationship or foreign key named in the C parameter are numbered in order, starting with "t2" =item * The table(s) that correspond to each relationship or foreign key named in the C parameter are numbered in order, starting where the C table aliases left off. =back "Many to many" relationships have two corresponding tables, and therefore will use two "tN" numbers. All other supported of relationship types only have just one table and will therefore use a single "tN" number. For example, imagine that the C class shown in the L also has a "many to many" relationship named "colors." Now consider this call: $products = Product::Manager->get_products( require_objects => [ 'category' ], with_objects => [ 'code_names', 'colors' ], multi_many_ok => 1, query => [ status => 'defunct' ], sort_by => 't1.name'); The "products" table is "t1" since it's the primary table--the table behind the C class that C manages. Next, the C tables are aliased. The "code_names" table is "t2". Since "colors" is a "many to many" relationship, it gets two numbers: "t3" and "t4". Finally, the C tables are numbered: the table behind the foreign key "category" is "t5". Here's an annotated version of the example above: # Table aliases in the comments $products = Product::Manager->get_products( # t5 require_objects => [ 'category' ], # t2 t3, t4 with_objects => [ 'code_names', 'colors' ], multi_many_ok => 1, query => [ status => 'defunct' ], sort_by => 't1.name'); # "products" is "t1" Also note that the C parameter was used in order to suppress the warning that occurs when more than one "... to many" relationship is included in the combination of C and C ("code_names" (one to many) and "colors" (many to many) in this case). See the documentation for C below. The "tN" table aliases are for convenience, and to isolate end-user code from the actual table names. Ideally, the actual table names should only exist in one place in the entire code base: in the class definitions for each L-derived class. That said, when using L, the actual table names can be used as well. But be aware that some databases don't like a mix of table aliases and real table names in some kinds of queries. Valid parameters to L are: =over 4 =item B If set to true, C parameters with empty lists as values are allowed. For example: @ids = (); # empty list Product::Manager->get_products( query => [ id => \@ids, ... ]); By default, passing an empty list as a value will cause a fatal error. =item B A L-derived object used to access the database. If omitted, one will be created by calling the L method of the C. =item B If true, print the generated SQL to STDERR. =item B If set to any kind of true value, then the "DISTINCT" SQL keyword will be added to the "SELECT" statement. Specific values trigger the behaviors described below. If set to a simple scalar value that is true, then only the columns in the primary table ("t1") are fetched from the database. If set to a reference to an array of table names, "tN" table aliases, or relationship or foreign key names, then only the columns from the corresponding tables will be fetched. In the case of relationships that involve more than one table, only the "most distant" table is considered. (e.g., The map table is ignored in a "many to many" relationship.) Columns from the primary table ("t1") are always selected, regardless of whether or not it appears in the list. This parameter conflicts with the C parameter in the case where both provide a list of table names or aliases. In this case, if the value of the C parameter is also reference to an array table names or aliases, then a fatal error will occur. =item B ARRAYREF should be a reference to an array of table names or "tN" table aliases. Only the columns from the corresponding tables will be fetched. In the case of relationships that involve more than one table, only the "most distant" table is considered. (e.g., The map table is ignored in a "many to many" relationship.) Columns from the primary table ("t1") are always selected, regardless of whether or not it appears in the list. This parameter conflicts with the C parameter in the case where both provide a list of table names or aliases. In this case, then a fatal error will occur. =item B If true, this parameter is translated to be the equivalent of passing the L parameter and setting the C to C. For example, this: for_update => 1 is equivalent to this: lock => { type => 'for update' } See the L parameter below for more information. =item B A reference to a hash of hints that influence the SQL generated to fetch the objects. Hints are just "suggestions" and may be ignored, depending on the actual features of the database being queried. Use the L parameter to see the generated SQL. Most of the current hints apply to MySQL only. See the relevant documentation for more details: L The hints hash is keyed by tN table aliases or relationship names. The value of each key is a reference to a hash of hint directives. In the absence of any key for "t1" or the name of the primary table, the entire hints hash is considered applicable to the primary table. Valid hint directives are: =over 4 =item B If true, direct the database to choose the query plan that returns all the records as quickly as possible. =item B If true, indicate to the database that the result set is expected to be big. =item B If true, force the result to be put into a temporary table. =item B If true, ask the database to store the result in its query cache. =item B If true, ask the database to internally calculate the number of rows found, ignoring any L or L arguments. =item B Add a comment after the "SELECT" keyword in the query. TEXT should B be surrounded by any comment delimiters. The appropriate delimiters will be added automatically. =item B If true, direct the database to choose the query plan that returns the first result record as soon as possible. =item B Force the use of the named indexes, specified by an index name or a reference to an array of index names. =item B If true, give this query higher priority. =item B Ignore the named indexes, specified by an index name or a reference to an array of index names. =item B If true, ask the database not to store the result in its query cache. =item B If true, indicate to the database that the result set is expected to be small. =item B If true, ask the database to join the tables in the order that they are listed in the "FROM" clause of the SQL statement. =item B If true, any comparison operator used in the C that is not listed in the L documentation will cause a fatal error. The default value is determined by the L class method. =item B Prefer to use the named indexes, specified by an index name or a reference to an array of index names. =back =item B If true, then the data returned from the database will be directly "injected" into the objects returned by this method, bypassing the constructor and column mutator methods for each object class. The default is false. This parameter is ignored (i.e., treated as if it were false) if the C Select only the columns specified in either a comma-separated string of column names or a reference to an array of column names. Strings are naively split between each comma. If you need more complex parsing, please use the array-reference argument format instead. Column names should be prefixed by the appropriate "tN" table alias, the table name, or the foreign key or relationship name. The prefix should be joined to the column name with a dot ("."). Examples: C, C. Unprefixed columns are assumed to belong to the primary table ("t1") and are explicitly prefixed as such when selecting from more than one table. If a column name matches C then no prefix is applied. If the column name is "*" (e.g., C) then all columns from that table are selected. If an item in the referenced array is itself a reference to a scalar, then that item will be dereferenced and passed through unmodified. If selecting sub-objects via the C or C parameters, you must select the primary key columns from each sub-object table. Failure to do so will cause those sub-objects I to be created. Be warned that you should provide some way to determine which column or method and which class an item belongs to: a tN prefix, a column name, or at the very least an "... AS ..." alias clause. If any C or C arguments are included in this call, the C parameter and more than one table is participating in the query, then each selected column will be given a unique alias by prefixing it with its table alias and an underscore. The default value is false. Example: SELECT t1.id AS t1_id, t1.name AS t1_name, t2.id AS t2_id, t2.name AS t2_name FROM foo AS t1, bar AS t2 WHERE ... These unique aliases provide a technique of last resort for unambiguously addressing a column in a query clause. =item B This is an alias for the C parameter (see above). =item B When fetching related objects through a "L" relationship, objects of the L are not retrieved by default. Use this parameter to override the default behavior. If the value is "1", then each object fetched through a mapping table will have its associated map record available through a C attribute. If a method name is provided instead, then each object fetched through a mapping table will have its associated map record available through a method of that name. If the value is a reference to a hash, then the keys of the hash should be "many to many" relationship names, and the values should be the method names through which the maps records will be available for each relationship. =item B Also fetch sub-objects (if any) associated with rows in the primary table based on a reference to an array of L or L names defined for C. The supported relationship types are "L," "L," and "L". For each foreign key or relationship name listed in ARRAYREF, another table will be added to the query via an explicit LEFT OUTER JOIN. (Foreign keys whose columns are all NOT NULL are the exception, however. They are always fetched via inner joins.) The join conditions will be constructed automatically based on the foreign key or relationship definitions. Note that each related table must have a L-derived class fronting it. See the L for an example. "Many to many" relationships are a special case. They will add two tables to the query (the "map" table plus the table with the actual data), which will offset the "tN" table numbering by one extra table. Foreign key and relationship names may be chained, with dots (".") separating each name. For example, imagine three tables, C, C, and C, fronted by three L-derived classes, C, C, and C, respectively. Each C has a C, and each C has a C. To fetch Cs along with their Cs, and their vendors' Cs, provide a C argument like this: with_objects => [ 'vendor.region' ], This assumes that the C class has a relationship or foreign key named "vendor" that points to the product's C, and that the C class has a foreign key or relationship named "region" that points to the vendor's C. This chaining syntax can be used to traverse relationships of any kind, including "one to many" and "many to many" relationships, to an arbitrary depth. The following optional suffixes may be added after any name in the chain in order to override the join type used: Suffix Join Type ------ ---------- ! Inner join ? Left outer join Each link in a C chain uses a left outer join by default. In other words, the following C parameters are all equivalent: # These all mean the same thing with_objects => [ 'vendor.region' ] with_objects => [ 'vendor?.region?' ] with_objects => [ 'vendor.region?' ] with_objects => [ 'vendor?.region' ] Thus, it is only really useful to use the C suffix in C parameters (though the C suffixes don't do any harm). Here's a useful example of a call with hybrid join chain: $products = Product::Manager->get_products( with_objects => [ 'vendor!.region' ]); All product objects returned would have associated vendor objects, but those vendor object may or may not have associated region objects. Note that inner joins may be implicit and L may or may not be used. When in doubt, use the L parameter to see the generated SQL. B there may be a geometric explosion of redundant data returned by the database if you include more than one "... to many" relationship in ARRAYREF. Sometimes this may still be more efficient than making additional queries to fetch these sub-objects, but that all depends on the actual data. A warning will be emitted (via L) if you include more than one "... to many" relationship in ARRAYREF. If you're sure you know what you're doing, you can silence this warning by passing the C parameter with a true value. B the C list currently cannot be used to simultaneously fetch two objects that both front the same database table, I. One workaround is to make one class use a synonym or alias for one of the tables. Another option is to make one table a trivial view of the other. The objective is to get the table names to be different for each different class (even if it's just a matter of letter case, if your database is not case-sensitive when it comes to table names). =back =item B Accepts the same arguments as L, but just returns the number of objects that would have been fetched, or undef if there was an error. =item B Fetch objects using a custom SQL query. Pass either a single SQL query string or name/value parameters as arguments. Valid parameters are: =over 4 =item B A reference to an array of arguments to be passed to L's L method when the query is run. The number of items in this array must exactly match the number of placeholders in the SQL query. =item B A L-derived object used to access the database. If omitted, one will be created by calling the L method of the C. =item B The class name of the L-derived objects to be fetched. Defaults to the value returned by the L class method. =item B If true, then L's L method will be used (instead of the L method) when preparing the SQL statement that will fetch the objects. If omitted, the default value is determined by the L class method. =item B If true, C will be passed to each L-derived object when it is constructed. Defaults to true. =item B The SQL query string. This parameter is required. =back Each column returned by the SQL query must be either a column or method name in C. Column names take precedence in the case of a conflict. Returns a reference to an array of C objects. Examples: package Product::Manager; use Product; use base 'Rose::DB::Object::Manager'; sub object_class { 'Product' } ... $products = Product::Manager->get_objects_from_sql(<<"EOF"); SELECT * FROM products WHERE sku % 2 != 0 ORDER BY status, type EOF $products = Product::Manager->get_objects_from_sql( args => [ '2005-01-01' ], sql => 'SELECT * FROM products WHERE release_date > ?'); =item B Accepts any valid L arguments, but return a L object, or undef if there was an error. =item B Accepts any valid L arguments, but return a L object, or undef if there was an error. =item B Accepts the same arguments as L, but return the SQL query string that would have been used to fetch the objects (in scalar context), or the SQL query string and a reference to an array of bind values (in list context). =item B Create convenience wrappers for L's L, L, and L class methods in the target class. These wrapper methods will not overwrite any existing methods in the target class. If there is an existing method with the same name, a fatal error will occur. PARAMS can take several forms, depending on the calling context. For a call to L to succeed, the following information must be determined: =over 4 =item * B The class of the L-derived objects to be fetched or counted. =item * B or B The base name is a string used as the basis of the method names. For example, the base name "products" might be used to create methods named "get_B", "get_B_count", "get_B_iterator", "delete_B", and "update_B". In the absence of a base name, an explicit method name may be provided instead. The method name will be used as is. =item * B The types of methods that should be generated. Each method type is a wrapper for a L class method. The mapping of method type names to actual L class methods defaults to the following: Type Method -------- ---------------------- objects get_objects() iterator get_objects_iterator() count get_objects_count() delete delete_objects() update update_objects() You may override the L method in the L's L class to customize one or more of these names. =item * B The class that the methods should be installed in. =back Here are all of the different ways that each of those pieces of information can be provided, either implicitly or explicitly as part of PARAMS. =over 4 =item * B If an C parameter is passed in PARAMS, then its value is used as the object class. Example: $class->make_manager_methods(object_class => 'Product', ...); If the C parameter is not passed, and if the B inherits from L and has also defined an C method, then the return value of that method is used as the object class. Example: package Product::Manager; use Rose::DB::Object::Manager; our @ISA = qw(Rose::DB::Object::Manager); sub object_class { 'Product' } # Assume object_class parameter is not part of the ... below __PACKAGE__->make_manager_methods(...); In this case, the object class would be C. Finally, if none of the above conditions are met, one final option is considered. If the B inherits from L, then the object class is set to the B. If the object class cannot be determined in one of the ways described above, then a fatal error will occur. =item * B or B If a C parameter is passed in PARAMS, then its value is used as the base name for the generated methods. Example: $class->make_manager_methods(base_name => 'products', ...); If the C parameter is not passed, and if there is only one argument passed to the method, then the lone argument is used as the base name. Example: $class->make_manager_methods('products'); (Note that, since the B must be derived somehow, this will only work in one of the situations (described above) where the B can be derived from the calling context or class.) If a C parameter is passed with a hash ref value, then each key of the hash is used as the base name for the method types listed in the corresponding value. (See B below for more information.) If a key of the C hash ends in "()", then it is taken as the method name and is used as is. For example, the key "foo" will be used as a base name, but the key "foo()" will be used as a method name. If the base name cannot be determined in one of the ways described above, then the L method in the L's L is called on to supply a base name. =item * B If an explicit list of method types is not passed to the method, then all of the L are created. Example: # Base name is determined by convention manager auto_manager_base_name() # method, all default method types created $class->make_manager_methods(); # Base name is "products", all default method types created $class->make_manager_methods('products'); # Base name is "products", all default method types created $class->make_manager_methods(base_name => products', ...); (Again, note that the B must be derived somehow.) If a C parameter is passed, then its value must be a reference to a hash whose keys are base names or method names, and whose values are method types or references to arrays of method types. If a key ends in "()", then it is taken as a method name and is used as is. Otherwise, it is used as a base name. For example, the key "foo" will be used as a base name, but the key "foo()" will be used as a method name. If a key is a method name and its value specifies more than one method type, then a fatal error will occur. (It's impossible to have more than one method with the same name.) Example: # Make the following methods: # # * Base name: products; method types: objects, iterators # # get_products() # get_products_iterator() # # * Method name: product_count; method type: count # # product_count() # $class->make_manager_methods(..., methods => { 'products' => [ qw(objects iterator) ], 'product_count()' => 'count' }); If the value of the C parameter is not a reference to a hash, or if both the C and C parameters are passed, then a fatal error will occur. =item * B If a C parameter is passed in PARAMS, then its value is used as the target class. Example: $class->make_manager_methods(target_class => 'Product', ...); If a C parameter is not passed, and if the calling class is not L, then the calling class is used as the target class. Otherwise, the class from which the method was called is used as the target class. Examples: # Target class is Product, regardless of the calling # context or the value of $class $class->make_manager_methods(target_class => 'Product', ...); package Foo; # Target class is Foo: no target_class parameter is passed # and the calling class is Rose::DB::Object::Manager, so # the class from which the method was called (Foo) is used. Rose::DB::Object::Manager->make_manager_methods( object_class => 'Bar', base_name => 'Baz'); package Bar; # Target class is Foo: no target_class parameter is passed # and the calling class is not Rose::DB::Object::Manager, # so the calling class (Foo) is used. Foo->make_manager_methods(object_class => 'Bar', base_name => 'Baz'); =back There's a lot of flexibility in this method's arguments (although some might use the word "confusion" instead), but the examples can be pared down to a few common usage scenarios. The first is the recommended technique, as seen in the L. Create a separate manager class that inherits from L, override the C method to specify the class of the objects being fetched, and then pass a lone base name argument to the call to L. package Product::Manager; use Rose::DB::Object::Manager; our @ISA = qw(Rose::DB::Object::Manager); sub object_class { 'Product' } __PACKAGE__->make_manager_methods('products'); The second example is used to install object manager methods directly into a L-derived class. I do not recommend this practice; I consider it "semantically impure" for the class that represents a single object to also be the class that's used to fetch multiple objects. Inevitably, classes grow, and I'd like the "object manager" class to be separate from the object class itself so they can grow happily in isolation, with no potential clashes. Also, keep in mind that L and L have separate L settings which must be synchronized or otherwise dealt with. Another advantage of using a separate L subclass (as described earlier) is that you can override the L in your L subclass only, rather than overriding the base class L, which may affect other classes. If none of that dissuades you, here's how to do it: package Product; use Rose::DB::Object:; our @ISA = qw(Rose::DB::Object); __PACKAGE__->make_manager_methods('products'); Finally, sometimes you don't want or need to use L at all. In fact, this method did not exist in earlier versions of this module. The formerly recommended way to use this class is still perfectly valid: subclass it and then call through to the base class methods. package Product::Manager; use Rose::DB::Object::Manager; our @ISA = qw(Rose::DB::Object::Manager); sub get_products { shift->get_objects(object_class => 'Product', @_); } sub get_products_iterator { shift->get_objects_iterator(object_class => 'Product', @_); } sub get_products_count { shift->get_objects_count(object_class => 'Product', @_); } sub delete_products { shift->delete_objects(object_class => 'Product', @_); } sub update_products { shift->update_objects(object_class => 'Product', @_); } Of course, these methods will all look very similar in each L-derived class. Creating these identically structured methods is exactly what L automates for you. But sometimes you want to customize these methods, in which case the "longhand" technique above becomes essential. For example, imagine that we want to extend the code in the L, adding support for a C parameter to the C method. Product::Manager->get_products(date_created => '10/21/2001', with_categories => 1); ... sub get_products { my($class, %args) @_; if(delete $args{'with_categories'}) # boolean flag { push(@{$args{'with_objects'}}, 'category'); } Rose::DB::Object::Manager->get_objects( %args, object_class => 'Product') } Here we've coerced the caller-friendly C boolean flag parameter into the C [ 'category' ]> pair that L's L method can understand. This is the typical evolution of an object manager method. It starts out as being auto-generated by L, then becomes customized as new arguments are added. =item B SQL | PARAMS ]> Create a class method in the calling class that will fetch objects using a custom SQL query. The method created will return a reference to an array of objects or a L object, depending on whether the C parameter is set (see below). Pass either a method name and an SQL query string or name/value parameters as arguments. Valid parameters are: =over 4 =item B If true, the method created will return a L object. =item B The class name of the L-derived objects to be fetched. Defaults to the value returned by the L class method. =item B To allow the method that will be created to accept named parameters (name/value pairs) instead of positional parameters, provide a reference to an array of parameter names in the order that they should be passed to the call to L's L method. =item B The name of the method to be created. This parameter is required. =item B If true, then L's L method will be used (instead of the L method) when preparing the SQL statement that will fetch the objects. If omitted, the default value is determined by the L class method. =item B If true, C will be passed to each L-derived object when it is constructed. Defaults to true. =item B The SQL query string. This parameter is required. =back Each column returned by the SQL query must be either a column or method name in C. Column names take precedence in the case of a conflict. Arguments passed to the created method will be passed to L's L method when the query is run. The number of arguments must exactly match the number of placeholders in the SQL query. Positional parameters are required unless the C parameter is used. (See description above.) Returns a code reference to the method created. Examples: package Product::Manager; use base 'Rose::DB::Object::Manager'; ... # Make method that takes no arguments __PACKAGE__->make_manager_method_from_sql(get_odd_products =><<"EOF"); SELECT * FROM products WHERE sku % 2 != 0 EOF # Make method that takes one positional parameter __PACKAGE__->make_manager_method_from_sql(get_new_products =><<"EOF"); SELECT * FROM products WHERE release_date > ? EOF # Make method that takes named parameters __PACKAGE__->make_manager_method_from_sql( method => 'get_named_products', params => [ qw(type name) ], sql => <<"EOF"); SELECT * FROM products WHERE type = ? AND name LIKE ? EOF ... $products = Product::Manager->get_odd_products(); $products = Product::Manager->get_new_products('2005-01-01'); $products = Product::Manager->get_named_products( name => 'Kite%', type => 'toy'); # Make method that takes named parameters and returns an iterator __PACKAGE__->make_manager_method_from_sql( method => 'get_named_products_iterator', iterator => 1, params => [ qw(type name) ], sql => <<"EOF"); SELECT * FROM products WHERE type = ? AND name LIKE ? EOF $iterator = Product::Manager->get_named_products_iterator( name => 'Kite%', type => 'toy'); while(my $product = $iterator->next) { ... # do something with $product $iterator->finish if(...); # finish early? } =item B This method takes ARGS in the forms accepted by L (and other similar methods) and normalizes them into name/value pairs. Since L can take arguments in many forms, this method is useful when overriding L in a custom L subclass. Example: package Product::Manager; use base 'Rose::DB::Object::Manager'; use Product; sub object_class { 'Product' } ... sub get_products { my($class, %args) = shift->normalize_get_objects_args(@_); # Detect, extract, and handle custom argument if(delete $args{'active_only'}) { push(@{$args{'query'}}, status => 'active'); } return $class->get_objects(%args); # call through to normal method } Now all of the following calls will work: $products = Product::Manager->get_products([ type => 'boat' ], sort_by => 'name'); $products = Product::Manager->get_products({ name => { like => '%Dog%' } }); $products = Product::Manager->get_products([ id => { gt => 123 } ], active_only => 1); =item B Returns the class name of the L-derived objects to be managed by this class. Override this method in your subclass. The default implementation returns undef. =item B Attempts to create the Perl source code that is equivalent to the current class. This works best for classes created via L's L method, but it will also work most of the time for classes whose methods were created using L. The Perl code is returned as a string. Here's an example: package My::Product::Manager; use My::Product; use Rose::DB::Object::Manager; our @ISA = qw(Rose::DB::Object::Manager); sub object_class { 'My::Product' } __PACKAGE__->make_manager_methods('products'); 1; =item B Update rows in a table fronted by a L-derived class based on PARAMS, where PARAMS are name/value pairs. Returns the number of rows updated, or undef if there was an error. Valid parameters are: =over 4 =item B If set to a true value, this parameter indicates an explicit request to update all rows in the table. If both the C and the C parameters are passed, a fatal error will occur. =item B A L-derived object used to access the database. If omitted, one will be created by calling the L method of the C. =item B The class name of the L-derived class that fronts the table whose rows will to be updated. This parameter is required; a fatal error will occur if it is omitted. Defaults to the value returned by the L class method. =item B The names and values of the columns to be updated. PARAMS should be a reference to a hash. Each key of the hash should be a column name or column get/set method name. If a value is a simple scalar, then it is passed through the get/set method that services the column before being incorporated into the SQL query. If a value is a reference to a scalar, then it is dereferenced and incorporated into the SQL query as-is. If a value is a reference to a hash, then it must contain a single key named "sql" and a corresponding value that will be incorporated into the SQL query as-is. Example: $num_rows_updated = Product::Manager->update_products( set => { end_date => DateTime->now, region_num => { sql => 'region_num * -1' } count => \q(count + 1), status => 'defunct', }, where => [ status => [ 'stale', 'old' ], name => { like => 'Wax%' } or => [ start_date => { gt => '2008-12-30' }, end_date => { gt => 'now' }, ], ]); The call above would execute an SQL statement something like the one shown below (depending on the database vendor, and assuming the current date was September 20th, 2005): UPDATE products SET end_date = '2005-09-20', region_num = region_num * -1, count = count + 1, status = 'defunct' WHERE status IN ('stale', 'old') AND name LIKE 'Wax%' AND ( start_date > '2008-12-30' OR end_date > '2005-09-20' ) =item B The query parameters, passed as a reference to an array of name/value pairs. These PARAMS are used to formulate the "where" clause of the SQL query that is used to update the rows in the table. Arbitrarily nested boolean logic is supported. For the complete list of valid parameter names and values, see the documentation for the C parameter of the L function in the L module. If this parameter is omitted, this method will refuse to update all rows in the table and a fatal error will occur. To update all rows in a table, you must pass the C parameter with a true value. If both the C and the C parameters are passed, a fatal error will occur. =back =item B Get or set a boolean value that indicates whether using a comparison operator in the C that is not listed in the L documentation will cause a fatal error. The default value is false. =back =head1 SUPPORT For an informal overview of L, including L, consult the L. perldoc Rose::DB::Object::Tutorial Any L questions or problems can be posted to the L mailing list. To subscribe to the list or view the archives, go here: L Although the mailing list is the preferred support mechanism, you can also email the author (see below) or file bugs using the CPAN bug tracking system: L There's also a wiki and other resources linked from the Rose project home page: L =head1 AUTHOR John C. Siracusa (siracusa@gmail.com) =head1 LICENSE Copyright (c) 2010 by John C. Siracusa. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Rose-DB-Object-0.810/lib/Rose/DB/Object/Metadata/000750 000765 000120 00000000000 12266514755 021105 5ustar00johnadmin000000 000000 Rose-DB-Object-0.810/lib/Rose/DB/Object/Metadata.pm000755 000765 000120 00000707035 12235452535 021460 0ustar00johnadmin000000 000000 package Rose::DB::Object::Metadata; use strict; use Carp(); use Rose::Object; our @ISA = qw(Rose::Object); use Rose::DB::Object::Util qw(lazy_column_values_loaded_key); use Rose::DB::Object::Constants qw(PRIVATE_PREFIX STATE_IN_DB MODIFIED_COLUMNS); use Rose::DB::Object::ConventionManager; use Rose::DB::Object::ConventionManager::Null; use Rose::DB::Object::Metadata::PrimaryKey; use Rose::DB::Object::Metadata::UniqueKey; use Rose::DB::Object::Metadata::ForeignKey; use Rose::DB::Object::Metadata::Column::Scalar; use Rose::DB::Object::Metadata::Relationship::OneToOne; # Attempt to load Scalar::Util::Clone at runtime and ignore any errors # to keep it from being a "hard" requirement. eval { local $@; require Scalar::Util::Clone }; use Clone(); # This is the backup clone method our $VERSION = '0.799'; our $Debug = 0; # # Object data # use Rose::Object::MakeMethods::Generic ( scalar => [ 'class', 'error', 'pre_init_hook', 'post_init_hook', '_object_default_manager_base_class', ], 'scalar --get_set_init' => [ 'db', 'db_id', 'primary_key', 'column_name_to_method_name_mapper', 'original_class', 'auto_prime_caches', ], boolean => [ allow_inline_column_values => { default => 0 }, is_initialized => { default => 0 }, is_auto_initializating => { default => 0 }, allow_auto_initialization => { default => 0 }, was_auto_initialized => { default => 0 }, initialized_foreign_keys => { default => 0 }, default_load_speculative => { default => 0 }, auto_load_related_classes => { default => 1 }, default_update_changes_only => { default => 0 }, default_insert_changes_only => { default => 0 }, default_cascade_save => { default => 0 }, default_smart_modification => { default => 0 }, include_predicated_unique_indexes => { default => 0 }, ], 'array --get_set_inited' => [ 'columns_ordered', 'nonpersistent_columns_ordered', ] ); # # Class data # use Rose::Class::MakeMethods::Generic ( inheritable_scalar => [ 'dbi_prepare_cached', 'default_column_undef_overrides_default', '_class_default_manager_base_class', ], inheritable_hash => [ column_type_classes => { interface => 'get_set_all' }, column_type_names => { interface => 'keys', hash_key => 'column_type_classes' }, _column_type_class => { interface => 'get_set', hash_key => 'column_type_classes' }, _delete_column_type_class => { interface => 'delete', hash_key => 'column_type_classes' }, auto_helper_classes => { interface => 'get_set_all' }, delete_auto_helper_class => { interface => 'delete', hash_key => 'auto_helper_classes' }, relationship_type_classes => { interface => 'get_set_all' }, relationship_type_class => { interface => 'get_set', hash_key => 'relationship_type_classes' }, delete_relationship_type_class => { interface => 'delete', hash_key => 'relationship_type_classes' }, class_registry => => { interface => 'get_set_all' }, convention_manager_classes => { interface => 'get_set_all' }, convention_manager_class => { interface => 'get_set', hash_key => 'convention_manager_classes' }, delete_convention_manager_class => { interface => 'delete', hash_key => 'convention_manager_classes' }, ], ); __PACKAGE__->default_manager_base_class('Rose::DB::Object::Manager'); __PACKAGE__->dbi_prepare_cached(1); __PACKAGE__->class_registry({}); __PACKAGE__->auto_helper_classes ( 'informix' => 'Rose::DB::Object::Metadata::Auto::Informix', 'pg' => 'Rose::DB::Object::Metadata::Auto::Pg', 'mysql' => 'Rose::DB::Object::Metadata::Auto::MySQL', 'sqlite' => 'Rose::DB::Object::Metadata::Auto::SQLite', 'oracle' => 'Rose::DB::Object::Metadata::Auto::Oracle', 'generic' => 'Rose::DB::Object::Metadata::Auto::Generic', ); __PACKAGE__->convention_manager_classes ( 'default' => 'Rose::DB::Object::ConventionManager', 'null' => 'Rose::DB::Object::ConventionManager::Null', ); __PACKAGE__->column_type_classes ( 'scalar' => 'Rose::DB::Object::Metadata::Column::Scalar', 'char' => 'Rose::DB::Object::Metadata::Column::Character', 'character' => 'Rose::DB::Object::Metadata::Column::Character', 'varchar' => 'Rose::DB::Object::Metadata::Column::Varchar', 'varchar2' => 'Rose::DB::Object::Metadata::Column::Varchar', 'nvarchar' => 'Rose::DB::Object::Metadata::Column::Varchar', 'nvarchar2' => 'Rose::DB::Object::Metadata::Column::Varchar', 'string' => 'Rose::DB::Object::Metadata::Column::Varchar', 'text' => 'Rose::DB::Object::Metadata::Column::Text', 'blob' => 'Rose::DB::Object::Metadata::Column::Blob', 'bytea' => 'Rose::DB::Object::Metadata::Column::Pg::Bytea', 'bits' => 'Rose::DB::Object::Metadata::Column::Bitfield', 'bitfield' => 'Rose::DB::Object::Metadata::Column::Bitfield', 'bool' => 'Rose::DB::Object::Metadata::Column::Boolean', 'boolean' => 'Rose::DB::Object::Metadata::Column::Boolean', 'int' => 'Rose::DB::Object::Metadata::Column::Integer', 'integer' => 'Rose::DB::Object::Metadata::Column::Integer', 'tinyint' => 'Rose::DB::Object::Metadata::Column::Integer', 'smallint' => 'Rose::DB::Object::Metadata::Column::Integer', 'mediumint' => 'Rose::DB::Object::Metadata::Column::Integer', 'bigint' => 'Rose::DB::Object::Metadata::Column::BigInt', 'serial' => 'Rose::DB::Object::Metadata::Column::Serial', 'bigserial' => 'Rose::DB::Object::Metadata::Column::BigSerial', 'enum' => 'Rose::DB::Object::Metadata::Column::Enum', 'num' => 'Rose::DB::Object::Metadata::Column::Numeric', #'number' => 'Rose::DB::Object::Metadata::Column::Numeric', 'numeric' => 'Rose::DB::Object::Metadata::Column::Numeric', 'decimal' => 'Rose::DB::Object::Metadata::Column::Numeric', 'float' => 'Rose::DB::Object::Metadata::Column::Float', 'float8' => 'Rose::DB::Object::Metadata::Column::DoublePrecision', 'double precision' => 'Rose::DB::Object::Metadata::Column::DoublePrecision', 'time' => 'Rose::DB::Object::Metadata::Column::Time', 'interval' => 'Rose::DB::Object::Metadata::Column::Interval', 'date' => 'Rose::DB::Object::Metadata::Column::Date', 'datetime' => 'Rose::DB::Object::Metadata::Column::Datetime', 'timestamp' => 'Rose::DB::Object::Metadata::Column::Timestamp', 'timestamp with time zone' => 'Rose::DB::Object::Metadata::Column::TimestampWithTimeZone', 'timestamp without time zone' => 'Rose::DB::Object::Metadata::Column::Timestamp', 'datetime year to fraction' => 'Rose::DB::Object::Metadata::Column::DatetimeYearToFraction', 'datetime year to fraction(1)' => 'Rose::DB::Object::Metadata::Column::DatetimeYearToFraction1', 'datetime year to fraction(2)' => 'Rose::DB::Object::Metadata::Column::DatetimeYearToFraction2', 'datetime year to fraction(3)' => 'Rose::DB::Object::Metadata::Column::DatetimeYearToFraction3', 'datetime year to fraction(4)' => 'Rose::DB::Object::Metadata::Column::DatetimeYearToFraction4', 'datetime year to fraction(5)' => 'Rose::DB::Object::Metadata::Column::DatetimeYearToFraction5', 'datetime year to second' => 'Rose::DB::Object::Metadata::Column::DatetimeYearToSecond', 'datetime year to minute' => 'Rose::DB::Object::Metadata::Column::DatetimeYearToMinute', 'datetime year to month' => 'Rose::DB::Object::Metadata::Column::DatetimeYearToMonth', 'epoch' => 'Rose::DB::Object::Metadata::Column::Epoch', 'epoch hires' => 'Rose::DB::Object::Metadata::Column::Epoch::HiRes', 'array' => 'Rose::DB::Object::Metadata::Column::Array', 'set' => 'Rose::DB::Object::Metadata::Column::Set', 'chkpass' => 'Rose::DB::Object::Metadata::Column::Pg::Chkpass', ); __PACKAGE__->relationship_type_classes ( 'one to one' => 'Rose::DB::Object::Metadata::Relationship::OneToOne', 'one to many' => 'Rose::DB::Object::Metadata::Relationship::OneToMany', 'many to one' => 'Rose::DB::Object::Metadata::Relationship::ManyToOne', 'many to many' => 'Rose::DB::Object::Metadata::Relationship::ManyToMany', ); # # Methods # sub init_column_name_to_method_name_mapper() { 0 } our %Objects; sub new { my($this_class, %args) = @_; my $class = $args{'class'} or Carp::croak "Missing required 'class' parameter"; return $Objects{$class} ||= shift->SUPER::new(@_); } sub init { my($self) = shift; # This attribute will be accessed many times, and a default # of 0 is usually a "faster false" than undef. $self->sql_qualify_column_names_on_load(0); $self->SUPER::init(@_); } sub init_original_class { ref shift } sub init_auto_prime_caches { $ENV{'MOD_PERL'} ? 1 : 0 } sub default_manager_base_class { my($self_or_class) = shift; if(ref($self_or_class)) { return $self_or_class->_object_default_manager_base_class(@_) || ref($self_or_class)->_class_default_manager_base_class; } return $self_or_class->_class_default_manager_base_class(@_); } sub reset { my($self) = shift; $self->is_initialized(0); $self->allow_auto_initialization(0); $self->was_auto_initialized(0); $self->initialized_foreign_keys(0); return; } sub clone { my($self) = shift; # The easy way: use Scalar::Util::Clone if(defined $Scalar::Util::Clone::VERSION) { return Scalar::Util::Clone::clone($self); } # The hard way: Clone.pm plus mucking my $meta = Clone::clone($self); # Reset all the parent back-links foreach my $item (grep { defined } $meta->columns, $meta->primary_key, $meta->unique_keys, $meta->foreign_keys, $meta->relationships) { $item->parent($meta); } return $meta; } sub allow_inheritance_from_meta { my($class, $meta) = @_; return $meta->num_columns > 0 ? 1 : 0; } sub for_class { my($meta_class, $class) = (shift, shift); return $Objects{$class} if($Objects{$class}); # Clone an ancestor meta object foreach my $parent_class (__get_parents($class)) { if(my $parent_meta = $Objects{$parent_class}) { next unless($meta_class->allow_inheritance_from_meta($parent_meta)); my $meta = $parent_meta->clone; $meta->reset(0); $meta->class($class); return $Objects{$class} = $meta; } } return $Objects{$class} = $meta_class->new(class => $class); } sub __get_parents { my($class) = shift; my @parents; no strict 'refs'; foreach my $sub_class (@{"${class}::ISA"}) { push(@parents, __get_parents($sub_class)) if($sub_class->isa('Rose::DB::Object')); } return $class, @parents; } sub clear_all_dbs { my($class) = shift; foreach my $obj_class ($class->registered_classes) { $obj_class->meta->db(undef); } } sub error_mode { return $_[0]->{'error_mode'} ||= $_[0]->init_error_mode unless(@_ > 1); my($self, $mode) = @_; unless($mode =~ /^(?:return|carp|croak|cluck|confess|fatal)$/) { Carp::croak "Invalid error mode: '$mode'"; } return $self->{'error_mode'} = $mode; } sub init_error_mode { 'fatal' } sub handle_error { my($self, $object) = @_; my $mode = $self->error_mode; return if($mode eq 'return'); my $level = $Carp::CarpLevel; local $Carp::CarpLevel = $level + 1; if($mode eq 'croak' || $mode eq 'fatal') { Carp::croak $object->error; } elsif($mode eq 'carp') { Carp::carp $object->error; } elsif($mode eq 'cluck') { Carp::cluck $object->error; } elsif($mode eq 'confess') { Carp::confess $object->error; } else { Carp::croak "(Invalid error mode set: '$mode') - ", $object->error; } return 1; } sub setup { my($self) = shift; return 1 if($self->is_initialized); my $init_args = []; my $auto_init = 0; PAIR: while(@_) { my $method = shift; if(ref $method eq 'CODE') { $method->($self); next PAIR; } my $args = shift; if($method =~ /^((?:auto_(?!helper)|(?:default_)?perl_)\w*)$/) { $self->init_auto_helper; } if($method eq 'initialize') { $init_args = ref $args ? $args : [ $args ]; next PAIR; } elsif($method eq 'auto_initialize' || $method eq 'auto') { unless($method eq 'auto' && !ref $args) { $init_args = ref $args ? $args : [ $args ]; } $auto_init = 1; next PAIR; } elsif($method eq 'helpers') { require Rose::DB::Object::Helpers; Rose::DB::Object::Helpers->import( '--target-class' => $self->class, (ref $args eq 'ARRAY' ? @$args : $args)); next PAIR; } unless($self->can($method)) { Carp::croak "Invalid parameter name: '$method'"; } if(ref $args eq 'ARRAY') { # Special case for the unique_key and add_unique_key methods # when the argument is a single array reference containing only # non-reference values if(($method eq 'unique_key' || $method eq 'add_unique_key') && !grep { ref } @$args) { $self->$method($args); } else { $self->$method(@$args); } } else { $self->$method($args); } } if($auto_init) { $self->auto_initialize(@$init_args); } else { $self->initialize(@$init_args); } return 1; } sub init_db { my($self) = shift; my $class = $self->class or die "Missing class!"; my $db = $self->class->init_db or Carp::croak "Could not init_db() for class $class - are you sure that ", "Rose::DB's data sources are set up?"; $self->{'db_id'} = $db->{'id'}; return $db; } sub init_db_id { my($self) = shift; $self->init_db; return $self->{'db_id'}; } sub init_convention_manager { shift->convention_manager_class('default')->new } sub convention_manager { my($self) = shift; if(@_) { my $mgr = shift; # Setting to undef means use the null convention manager if(!defined $mgr) { return $self->{'convention_manager'} = Rose::DB::Object::ConventionManager::Null->new(parent => $self); } elsif(!ref $mgr) { if(UNIVERSAL::isa($mgr, 'Rose::DB::Object::ConventionManager')) { $mgr = $mgr->new; } else { my $class = $self->convention_manager_class($mgr) or Carp::croak "No convention manager class registered under the name '$mgr'"; $mgr = $class->new; } } elsif(!UNIVERSAL::isa($mgr, 'Rose::DB::Object::ConventionManager')) { Carp::croak "$mgr is not a Rose::DB::Object::ConventionManager-derived object"; } $mgr->parent($self); return $self->{'convention_manager'} = $mgr; } if(defined $self->{'convention_manager'}) { return $self->{'convention_manager'}; } my $mgr = $self->init_convention_manager; $mgr->parent($self); return $self->{'convention_manager'} = $mgr; } sub cached_objects_expire_in { shift->class->cached_objects_expire_in(@_) } sub clear_object_cache { shift->class->clear_object_cache(@_) } sub prepare_select_options { @_ > 1 ? $_[0]->{'prepare_select_options'} = $_[1] : $_[0]->{'prepare_select_options'} ||= {} } sub prepare_insert_options { @_ > 1 ? $_[0]->{'prepare_insert_options'} = $_[1] : $_[0]->{'prepare_insert_options'} ||= {} } sub prepare_update_options { @_ > 1 ? $_[0]->{'prepare_update_options'} = $_[1] : $_[0]->{'prepare_update_options'} ||= {} } sub prepare_delete_options { @_ > 1 ? $_[0]->{'prepare_delete_options'} = $_[1] : $_[0]->{'prepare_delete_options'} ||= {} } sub prepare_bulk_delete_options { @_ > 1 ? $_[0]->{'prepare_bulk_delete_options'} = $_[1] : $_[0]->{'prepare_bulk_delete_options'} ||= $_[0]->prepare_delete_options; } sub prepare_bulk_update_options { @_ > 1 ? $_[0]->{'prepare_bulk_update_options'} = $_[1] : $_[0]->{'prepare_bulk_update_options'} ||= $_[0]->prepare_update_options; } sub prepare_options { my($self, $options) = @_; Carp::croak "Missing required hash ref argument to prepare_options()" unless(ref $options eq 'HASH'); $self->prepare_select_options({ %$options }); $self->prepare_insert_options({ %$options }); $self->prepare_update_options({ %$options }); $self->prepare_delete_options({ %$options }); } sub table { unless(@_ > 1) { return $_[0]->{'table'} ||= $_[0]->convention_manager->auto_table_name; } $_[0]->_clear_table_generated_values; return $_[0]->{'table'} = $_[1]; } sub catalog { return $_[0]->{'catalog'} unless(@_ > 1); $_[0]->_clear_table_generated_values; return $_[0]->{'catalog'} = $_[1]; } sub select_catalog { my($self, $db) = @_; return undef if($db && !$db->supports_catalog); return $self->{'catalog'} || ($db ? $db->catalog : undef); } sub schema { return $_[0]->{'schema'} unless(@_ > 1); $_[0]->_clear_table_generated_values; return $_[0]->{'schema'} = $_[1]; } sub select_schema { my($self, $db) = @_; return undef if($db && !$db->supports_schema); return $self->{'schema'} || ($db ? $db->schema : undef); } sub sql_qualify_column_names_on_load { my($self) = shift; if(@_) { my $value = $_[0] ? 1 : 0; no warnings 'uninitialized'; if($value != $self->{'sql_qualify_column_names_on_load'}) { $self->{'sql_qualify_column_names_on_load'} = $value; $self->_clear_column_generated_values; $self->prime_caches if($self->is_initialized); } } return $self->{'sql_qualify_column_names_on_load'}; } sub key_column_names { my($self) = shift; $self->{'key_column_names'} ||= [ $self->primary_key_columns, $self->unique_keys_column_names ]; return wantarray ? @{$self->{'key_column_names'}} : $self->{'key_column_names'}; } sub init_primary_key { Rose::DB::Object::Metadata::PrimaryKey->new(parent => shift); } sub primary_key_generator { shift->primary_key->generator(@_) } sub primary_key_columns { shift->primary_key->columns(@_) } sub primary_key_column_names { shift->primary_key->column_names(@_) } sub pk_columns { shift->primary_key_columns(@_) } sub primary_key_column_names_or_aliases { my($self) = shift; if($self->{'primary_key_column_names_or_aliases'}) { return $self->{'primary_key_column_names_or_aliases'}; } return $self->{'primary_key_column_names_or_aliases'} = [ map { $_->alias || $_->name } $self->primary_key_columns ]; } sub init_primary_key_column_info { my($self) = shift; my $pk_position = 0; foreach my $col_name ($self->primary_key_column_names) { $pk_position++; my $column = $self->column($col_name) or next; $column->is_primary_key_member(1); $column->primary_key_position($pk_position); } $self->_clear_primary_key_column_generated_values; # Init these by asking for them $self->primary_key_column_accessor_names; $self->primary_key_column_mutator_names; return; } sub add_primary_key_columns { my($self) = shift; $self->primary_key->add_columns(@_); $self->init_primary_key_column_info; return; } sub add_primary_key_column { shift->add_primary_key_columns(@_) } sub add_unique_keys { my($self) = shift; if(@_ == 1 && ref $_[0] eq 'ARRAY') { push @{$self->{'unique_keys'}}, Rose::DB::Object::Metadata::UniqueKey->new(parent => $self, columns => $_[0]); } else { push @{$self->{'unique_keys'}}, map { UNIVERSAL::isa($_, 'Rose::DB::Object::Metadata::UniqueKey') ? ($_->parent($self), $_) : ref $_ eq 'HASH' ? Rose::DB::Object::Metadata::UniqueKey->new(parent => $self, %$_) : Rose::DB::Object::Metadata::UniqueKey->new(parent => $self, columns => $_) } @_; } return; } sub unique_key_by_name { my($self, $name) = @_; foreach my $uk ($self->unique_keys) { return $uk if($uk->name eq $name); } return undef; } sub add_unique_key { shift->add_unique_keys(@_) } sub unique_key { \shift->add_unique_keys(@_) } sub delete_unique_keys { $_[0]->{'unique_keys'} = [] } sub unique_keys { my($self) = shift; if(@_) { $self->delete_unique_keys; $self->add_unique_keys(@_); } wantarray ? @{$self->{'unique_keys'} ||= []} : ($self->{'unique_keys'} ||= []); } sub unique_keys_column_names { wantarray ? map { scalar $_->column_names } @{shift->{'unique_keys'} ||= []} : [ map { scalar $_->column_names } @{shift->{'unique_keys'} ||= []} ]; } sub delete_column { my($self, $name) = @_; delete $self->{'columns'}{$name}; # Remove from ordered list too my $columns = $self->columns_ordered; for(my $i = 0; $i < @$columns; $i++) { if($columns->[$i]->name eq $name) { splice(@$columns, $i, 1); last; } } return; } sub delete_columns { my($self, $name) = @_; $self->{'columns'} = {}; $self->{'columns_ordered'} = []; return; } sub delete_nonpersistent_columns { my($self, $name) = @_; $self->{'nonpersistent_columns'} = {}; $self->{'nonpersistent_columns_ordered'} = []; return; } sub delete_nonpersistent_column { my($self, $name) = @_; delete $self->{'nonpersistent_columns'}{$name}; # Remove from ordered list too my $columns = $self->nonpersistent_columns_ordered; for(my $i = 0; $i < @$columns; $i++) { if($columns->[$i]->name eq $name) { splice(@$columns, $i, 1); last; } } return; } sub first_column { shift->columns_ordered->[0] } sub sync_keys_to_columns { my($self) = shift; $self->_clear_column_generated_values; my %columns = map { $_->name => 1 } $self->columns_ordered; foreach my $col_name ($self->primary_key_column_names) { unless($columns{$col_name}) { Carp::croak "Primary key column '$col_name' is not in the column list for ", $self->class; #$self->primary_key(undef); #last; } } my @valid_uks; UK: foreach my $uk ($self->unique_keys) { foreach my $col_name ($uk->column_names) { unless($columns{$col_name}) { Carp::croak "Column '$col_name' found in unique key is not in the column list for ", $self->class; #next UK; } } push(@valid_uks, $uk); } $self->unique_keys(@valid_uks); return; } sub replace_column { my($self) = shift; unless(@_ == 2) { Carp::croak "Missing column name and value arguments" if(@_ < 2); Carp::croak "Too many arguments passed to replace_column()" if(@_ < 2); } return $self->column(@_); } sub column { my($self, $name) = (shift, shift); if(@_) { $self->delete_column($name); $self->add_column($name => @_); } return $self->{'columns'}{$name} if($self->{'columns'}{$name}); return undef; } sub nonpersistent_column { my($self, $name) = (shift, shift); if(@_) { $self->delete_nonpersistent_column($name); $self->add_nonpersistent_column($name => @_); } return $self->{'nonpersistent_columns'}{$name} if($self->{'nonpersistent_columns'}{$name}); return undef; } sub columns { my($self) = shift; if(@_) { $self->delete_columns; $self->add_columns(@_); } return $self->columns_ordered; } sub nonpersistent_columns { my($self) = shift; if(@_) { $self->delete_nonpersistent_columns; $self->add_nonpersistent_columns(@_); } return $self->nonpersistent_columns_ordered; } sub num_columns { my($self) = shift; return $self->{'num_columns'} ||= scalar(@{$self->columns_ordered}); } sub nonlazy_columns { my($self) = shift; return wantarray ? (grep { !$_->lazy } $self->columns_ordered) : [ grep { !$_->lazy } $self->columns_ordered ]; } sub lazy_columns { my($self) = shift; return wantarray ? (grep { $_->lazy } $self->columns_ordered) : [ grep { $_->lazy } $self->columns_ordered ]; } # XXX: Super-lame code sharing via dynamically-scoped flag var our $Nonpersistent; sub add_nonpersistent_columns { local $Nonpersistent = 1; shift->_add_columns(@_); } sub add_nonpersistent_column { shift->add_nonpersistent_columns(@_) } sub add_columns { local $Nonpersistent = 0; shift->_add_columns(@_); } sub add_column { shift->add_columns(@_) } sub _add_columns { my($self) = shift; my $class = ref $self; my(@columns, @nonpersistent_columns); ARG: while(@_) { my $name = shift; if(UNIVERSAL::isa($name, 'Rose::DB::Object::Metadata::Column')) { my $column = $name; Carp::croak "Relationship $column lacks a name()" unless($column->name =~ /\S/); $column->parent($self); $column->nonpersistent(1) if($Nonpersistent); if($column->nonpersistent) { $self->{'nonpersistent_columns'}{$column->name} = $column; push(@nonpersistent_columns, $column); } else { $self->{'columns'}{$column->name} = $column; push(@columns, $column); } next; } unless(ref $_[0]) # bare column name, persistent only { my $column_class = $self->original_class->column_type_class('scalar') or Carp::croak "No column class set for column type 'scalar'"; #$Debug && warn $self->class, " - adding scalar column $name\n"; $self->{'columns'}{$name} = $column_class->new(name => $name, parent => $self); push(@columns, $self->{'columns'}{$name}); next; } if(UNIVERSAL::isa($_[0], 'Rose::DB::Object::Metadata::Column')) { my $column = $_[0]; $column->name($name); $column->parent($self); $column->nonpersistent(1) if($Nonpersistent); if($column->nonpersistent) { $self->{'nonpersistent_columns'}{$column->name} = $column; push(@nonpersistent_columns, $column); } else { $self->{'columns'}{$column->name} = $column; push(@columns, $column); } } elsif(ref $_[0] eq 'HASH') { my $info = shift; my $alias = $info->{'alias'}; if($info->{'primary_key'}) { #$Debug && warn $self->class, " - adding primary key column $name\n"; $self->add_primary_key_column($name); } my $methods = delete $info->{'methods'}; my $add_methods = delete $info->{'add_methods'}; if($methods && $add_methods) { Carp::croak "Cannot specify both 'methods' and 'add_methods' - ", "pick one or the other"; } my $type = $info->{'type'} ||= 'scalar'; my $column_class = $self->original_class->column_type_class($type) or Carp::croak "No column class set for column type '$type'"; unless($self->column_class_is_loaded($column_class)) { $self->load_column_class($column_class); } my %triggers; foreach my $event ($column_class->trigger_events) { $triggers{$event} = delete $info->{$event} if(exists $info->{$event}); } if(delete $info->{'temp'}) # coerce temp to nonpersistent { $info->{'nonpersistent'} = 1; } #$Debug && warn $self->class, " - adding $name $column_class\n"; # XXX: Order of args is important here! Parent must be set first # because some params rely on it being present when they're set. my $column = $column_class->new(parent => $self, %$info, name => $name); $column->nonpersistent(1) if($Nonpersistent); if($column->nonpersistent) { $self->{'nonpersistent_columns'}{$column->name} = $column; push(@nonpersistent_columns, $column); } else { $self->{'columns'}{$column->name} = $column; push(@columns, $column); } # Set or add auto-created method names if($methods || $add_methods) { my $auto_method_name = $methods ? 'auto_method_types' : 'add_auto_method_types'; my $methods_arg = $methods || $add_methods; if(ref $methods_arg eq 'HASH') { $methods = [ keys %$methods_arg ]; while(my($type, $name) = each(%$methods_arg)) { next unless(defined $name); $column->method_name($type => $name); } } else { $methods = $methods_arg; } $column->$auto_method_name($methods); } if(defined $alias) { $column->alias($alias); $self->alias_column($name, $alias); } if(%triggers) { while(my($event, $value) = each(%triggers)) { Carp::croak "Missing code reference for $event trigger" unless($value); foreach my $code (ref $value eq 'ARRAY' ? @$value : $value) { $column->add_trigger(event => $event, code => $code); } } } } else { Carp::croak "Invalid column name or specification: $_[0]"; } } # Handle as-yet undocumented smart modification defaults. # Smart modification is only relevant foreach my $column (@columns) { if($column->can('smart_modification') && !defined $column->{'smart_modification'}) { $column->smart_modification($self->default_smart_modification); } } if(@columns) { push(@{$self->{'columns_ordered'}}, @columns); $self->_clear_column_generated_values; } if(@nonpersistent_columns) { push(@{$self->{'nonpersistent_columns_ordered'}}, @nonpersistent_columns); $self->_clear_nonpersistent_column_generated_values; } return wantarray ? (@columns, @nonpersistent_columns) : [ @columns, @nonpersistent_columns ]; } sub relationship { my($self, $name) = (shift, shift); if(@_) { $self->delete_relationship($name); $self->add_relationship($name => $_[0]); } return $self->{'relationships'}{$name} if($self->{'relationships'}{$name}); return undef; } sub delete_relationship { my($self, $name) = @_; delete $self->{'relationships'}{$name}; return; } sub relationships { my($self) = shift; if(@_) { $self->delete_relationships; $self->add_relationships(@_); } return wantarray ? (sort { $a->name cmp $b->name } values %{$self->{'relationships'} ||= {}}) : [ sort { $a->name cmp $b->name } values %{$self->{'relationships'} ||= {}} ]; } sub delete_relationships { my($self) = shift; # Delete everything except fk proxy relationships foreach my $name (keys %{$self->{'relationships'} || {}}) { delete $self->{'relationships'}{$name} unless($self->{'relationships'}{$name}->foreign_key); } return; } sub add_relationships { my($self) = shift; my $class = ref $self; ARG: while(@_) { my $name = shift; # Relationship object if(UNIVERSAL::isa($name, 'Rose::DB::Object::Metadata::Relationship')) { my $relationship = $name; Carp::croak "Relationship $relationship lacks a name()" unless($relationship->name =~ /\S/); if(defined $self->{'relationships'}{$relationship->name}) { Carp::croak $self->class, " already has a relationship named '", $relationship->name, "'"; } $relationship->parent($self); $self->{'relationships'}{$relationship->name} = $relationship; next; } # Name and type only: recurse with hashref arg if(!ref $_[0]) { my $type = shift; $self->add_relationships($name => { type => $type }); next ARG; } if(UNIVERSAL::isa($_[0], 'Rose::DB::Object::Metadata::Relationship')) { my $relationship = shift; $relationship->name($name); $relationship->parent($self); $self->{'relationships'}{$name} = $relationship; } elsif(ref $_[0] eq 'HASH') { my $info = shift; if(defined $self->{'relationships'}{$name}) { Carp::croak $self->class, " already has a relationship named '$name'"; } my $methods = delete $info->{'methods'}; my $add_methods = delete $info->{'add_methods'}; if($methods && $add_methods) { Carp::croak "Cannot specify both 'methods' and 'add_methods' - ", "pick one or the other"; } my $type = $info->{'type'} or Carp::croak "Missing type parameter for relationship '$name'"; my $relationship = $self->{'relationships'}{$name} = $self->_build_relationship(name => $name, type => $type, info => $info); # Set or add auto-created method names if($methods || $add_methods) { my $auto_method_name = $methods ? 'auto_method_types' : 'add_auto_method_types'; my $methods_arg = $methods || $add_methods; if(ref $methods_arg eq 'HASH') { $methods = [ keys %$methods_arg ]; while(my($type, $name) = each(%$methods_arg)) { next unless(defined $name); $relationship->method_name($type => $name); } } else { $methods = $methods_arg; } $relationship->$auto_method_name($methods); } } else { Carp::croak "Invalid relationship name or specification: $_[0]"; } } } sub _build_relationship { my($self, %args) = @_; my $class = ref $self; my $name = $args{'name'} or Carp::croak "Missing name parameter"; my $info = $args{'info'} or Carp::croak "Missing info parameter"; my $type = $args{'type'} or Carp::croak "Missing type parameter for relationship '$name'"; my $relationship_class = $class->relationship_type_class($type) or Carp::croak "No relationship class set for relationship type '$type'"; unless($self->relationship_class_is_loaded($relationship_class)) { $self->load_relationship_class($relationship_class); } $Debug && warn $self->class, " - adding $name $relationship_class\n"; my $relationship = $self->convention_manager->auto_relationship($name, $relationship_class, $info) || $relationship_class->new(%$info, name => $name); unless($relationship) { Carp::croak "$class - Incomplete relationship specification could not be ", "completed by convention manager: $name"; } $relationship->parent($self); return $relationship; } sub add_relationship { shift->add_relationships(@_) } my %Class_Loaded; sub load_column_class { my($self, $column_class) = @_; unless(UNIVERSAL::isa($column_class, 'Rose::DB::Object::Metadata::Column')) { my $error; TRY: { local $@; eval "require $column_class"; $error = $@; } Carp::croak "Could not load column class '$column_class' - $error" if($error); } $Class_Loaded{$column_class}++; } sub column_class_is_loaded { $Class_Loaded{$_[1]} } sub column_type_class { my($class, $type) = (shift, shift); return $class->_column_type_class(lc $type, @_) } sub delete_column_type_class { my($class, $type) = (shift, shift); return $class->_delete_column_type_class(lc $type, @_) } sub load_relationship_class { my($self, $relationship_class) = @_; my $error; TRY: { local $@; eval "require $relationship_class"; $error = $@; } Carp::croak "Could not load relationship class '$relationship_class' - $error" if($error); $Class_Loaded{$relationship_class}++; } sub relationship_class_is_loaded { $Class_Loaded{$_[1]} } sub add_foreign_keys { my($self) = shift; ARG: while(@_) { my $name = shift; # Foreign key object if(UNIVERSAL::isa($name, 'Rose::DB::Object::Metadata::ForeignKey')) { my $fk = $name; Carp::croak "Foreign key $fk lacks a name()" unless($fk->name =~ /\S/); if(defined $self->{'foreign_keys'}{$fk->name}) { Carp::croak $self->class, " already has a foreign key named '", $fk->name, "'"; } $fk->parent($self); $self->{'foreign_keys'}{$fk->name} = $fk; unless(defined $self->relationship($fk->name)) { $self->add_relationship( $self->relationship_type_class($fk->relationship_type)->new( parent => $self, name => $fk->name, class => $fk->class, foreign_key => $fk)); } next ARG; } # Name only: try to get all the other info by convention if(!ref $_[0]) { if(my $fk = $self->convention_manager->auto_foreign_key($name)) { $self->add_foreign_keys($fk); next ARG; } else { Carp::croak $self->class, " - Incomplete foreign key specification could not be ", "completed by convention manager: $name"; } } # Name and hashref spec if(ref $_[0] eq 'HASH') { my $info = shift; if(defined $self->{'foreign_keys'}{$name}) { Carp::croak $self->class, " already has a foreign key named '$name'"; } my $methods = delete $info->{'methods'}; my $add_methods = delete $info->{'add_methods'}; if($methods && $add_methods) { Carp::croak "Cannot specify both 'methods' and 'add_methods' - ", "pick one or the other"; } $Debug && warn $self->class, " - adding $name foreign key\n"; my $fk = $self->{'foreign_keys'}{$name} = $self->convention_manager->auto_foreign_key($name, $info) || Rose::DB::Object::Metadata::ForeignKey->new(%$info, name => $name); $fk->parent($self); # Set or add auto-created method names if($methods || $add_methods) { my $auto_method_name = $methods ? 'auto_method_types' : 'add_auto_method_types'; my $methods_arg = $methods || $add_methods; if(ref $methods_arg eq 'HASH') { $methods = [ keys %$methods_arg ]; while(my($type, $name) = each(%$methods_arg)) { next unless(defined $name); $fk->method_name($type => $name); } } else { $methods = $methods_arg; } $fk->$auto_method_name($methods); } unless(defined $self->relationship($name)) { $self->add_relationship( $self->relationship_type_class($fk->relationship_type)->new( name => $name, class => $fk->class, foreign_key => $fk)); } } else { Carp::croak "Invalid foreign key specification: $_[0]"; } } } sub add_foreign_key { shift->add_foreign_keys(@_) } sub foreign_key { my($self, $name) = (shift, shift); if(@_) { $self->delete_foreign_key($name); $self->add_foreign_key($name => @_); } return $self->{'foreign_keys'}{$name} if($self->{'foreign_keys'}{$name}); return undef; } sub delete_foreign_key { my($self, $name) = @_; delete $self->{'foreign_keys'}{$name}; return; } sub delete_foreign_keys { my($self) = shift; # Delete fk proxy relationship foreach my $fk (values %{$self->{'foreign_keys'}}) { foreach my $rel ($self->relationships) { no warnings 'uninitialized'; if($rel->foreign_key eq $fk) { $self->delete_relationship($rel->name); } } } # Delete fks $self->{'foreign_keys'} = {}; return; } sub foreign_keys { my($self) = shift; if(@_) { $self->delete_foreign_keys; $self->add_foreign_keys(@_); } return wantarray ? (sort { $a->name cmp $b->name } values %{$self->{'foreign_keys'} ||= {}}) : [ sort { $a->name cmp $b->name } values %{$self->{'foreign_keys'} ||= {}} ]; } sub initialize { my($self) = shift; my(%args) = @_; $Debug && warn $self->class, " - initialize\n"; if(my $code = $self->pre_init_hook) { foreach my $sub (ref $code eq 'ARRAY' ? @$code : $code) { $sub->($self, @_); } } my $class = $self->class or Carp::croak "Missing class for metadata object $self"; $self->sync_keys_to_columns; my $table = $self->table; Carp::croak "$class - Missing table name" unless(defined $table && $table =~ /\S/); my @pk = $self->primary_key_column_names; Carp::croak "$class - Missing primary key for table '$table'" unless(@pk); $self->init_primary_key_column_info; my @column_names = $self->column_names; Carp::croak "$class - No columns defined for for table '$table'" unless(@column_names); foreach my $name ($self->primary_key_column_names) { my $column = $self->column($name) or Carp::croak "Could not find column for primary key column name '$name'"; if($column->is_lazy) { Carp::croak "Column '$name' cannot be lazy: cannot load primary key ", "columns on demand"; } } $self->make_methods(@_); $self->register_class; unless($args{'passive'}) { # Retry deferred stuff $self->retry_deferred_tasks; $self->retry_deferred_foreign_keys; $self->retry_deferred_relationships; } $self->refresh_lazy_column_tracking; unless($args{'stay_connected'}) { $self->db(undef); # make sure to ditch any db we may have retained } $self->is_initialized(1); $Debug && warn $self->class, " - initialized\n"; if(my $code = $self->post_init_hook) { foreach my $sub (ref $code eq 'ARRAY' ? @$code : $code) { $sub->($self, @_); } } # Regardless of cache priming, call this to ensure it's initialized, # since it is very likely to be used. $self->key_column_accessor_method_names_hash; $self->prime_caches if($self->auto_prime_caches); return; } use constant NULL_CATALOG => "\0"; use constant NULL_SCHEMA => "\0"; sub register_class { my($self) = shift; my $class = $self->class or Carp::croak "Missing class for metadata object $self"; my $db = $self->db; my $catalog = $self->select_catalog($db); my $schema = $db ? ($db->registration_schema || $self->select_schema($db)) : $self->select_schema($db);; $catalog = NULL_CATALOG unless(defined $catalog); $schema = NULL_SCHEMA unless(defined $schema); my $default_schema = $db ? $db->default_implicit_schema : undef; my $table = $self->table or Carp::croak "Missing table for metadata object $self"; $table = lc $table if($db->likes_lowercase_table_names); my $reg = $self->registry_key->class_registry; # Combine keys using $;, which is "\034" (0x1C) by default. But just to # make sure, I'll localize it. What I'm looking for is a value that # won't show up in a catalog, schema, or table name, so I'm guarding # against someone changing it to "-" (or whatever) elsewhere in the code. local $; = "\034"; # Register with all available information. # Ug, have to store lowercase versions too because MySQL sometimes returns # lowercase names for tables that are actually mixed case. Grrr... $reg->{'catalog-schema-table',$catalog,$schema,$table} = $reg->{'table',$table} = $reg->{'lc-catalog-schema-table',$catalog,$schema,lc $table} = $reg->{'lc-table',lc $table} = $class; $reg->{'catalog-schema-table',$catalog,$default_schema,$table} = $class if(defined $default_schema); push(@{$reg->{'classes'}}, $class); return; } sub registry_key { __PACKAGE__ } sub registered_classes { my($self) = shift; my $reg = $self->registry_key->class_registry; return wantarray ? @{$reg->{'classes'} ||= []} : $reg->{'classes'}; } sub unregister_all_classes { my($self) = shift; $self->registry_key->class_registry({}); return; } sub class_for { my($self_or_class, %args) = @_; my $self = ref($self_or_class) ? $self_or_class : undef; my $class = ref($self) || $self_or_class; my $db = $self ? $self->db : undef; my $catalog = $args{'catalog'}; my $schema = $args{'schema'}; $catalog = NULL_CATALOG unless(defined $catalog); $schema = NULL_SCHEMA unless(defined $schema); my $default_schema = $db ? $db->default_implicit_schema : undef; $default_schema = NULL_SCHEMA unless(defined $default_schema); my $table = $args{'table'} or Carp::croak "Missing required table parameter"; $table = lc $table if($db && $db->likes_lowercase_table_names); my $reg = $class->registry_key->class_registry; # Combine keys using $;, which is "\034" (0x1C) by default. But just to # make sure, we'll localize it. What we're looking for is a value that # wont' show up in a catalog, schema, or table name, so I'm guarding # against someone changing it to "-" elsewhere in the code or whatever. local $; = "\034"; my $f_class = $reg->{'catalog-schema-table',$catalog,$schema,$table} || $reg->{'catalog-schema-table',$catalog,$default_schema,$table} || ($schema eq NULL_SCHEMA && $default_schema eq NULL_SCHEMA ? $reg->{'lc-table',$table} : undef); # Ug, have to check lowercase versions too because MySQL sometimes returns # lowercase names for tables that are actually mixed case. Grrr... unless($f_class) { $table = lc $table; return $reg->{'lc-catalog-schema-table',$catalog,$schema,$table} || $reg->{'lc-catalog-schema-table',$catalog,$default_schema,$table} || ($schema eq NULL_SCHEMA && $default_schema eq NULL_SCHEMA ? $reg->{'lc-table',$table} : undef); } return $f_class; } #sub made_method_for_column #{ # (@_ > 2) ? ($_[0]->{'made_methods'}{$_[1]} = $_[2]) : # $_[0]->{'made_methods'}{$_[1]}; #} sub make_column_methods { my($self) = shift; my(%args) = @_; my $class = $self->class; $args{'target_class'} = $class; my $aliases = $self->column_aliases; while(my($column_name, $alias) = each(%$aliases)) { $self->column($column_name)->alias($alias); } foreach my $column ($self->columns_ordered) { unless($column->validate_specification) { Carp::croak "Column specification for column '", $column->name, "' in class ", $self->class, " is invalid: ", $column->error; } my $name = $column->name; my $method; foreach my $type ($column->auto_method_types) { $method = $self->method_name_from_column_name($name, $type) or Carp::croak "No method name defined for column '$name' ", "method type '$type'"; if(my $reason = $self->method_name_is_reserved($method, $class)) { Carp::croak "Cannot create method '$method' - $reason ", "Use alias_column() to map it to another name." } $column->method_name($type => $method); } #$Debug && warn $self->class, " - make methods for column $name\n"; $column->make_methods(%args); # XXX: Re-enabling the ability to alias primary keys #if($column->is_primary_key_member && $column->alias && $column->alias ne $column->name) #{ # Carp::croak "Primary key columns cannot be aliased (the culprit: '$name')"; #} # #if($method ne $name) #{ # # Primary key columns can be aliased, but we make a column-named # # method anyway. # foreach my $column ($self->primary_key_column_names) # { # if($name eq $column) # { # if(my $reason = $self->method_name_is_reserved($name, $class)) # { # Carp::croak # "Cannot create method for primary key column '$name' ", # "- $reason Although primary keys may be aliased, doing ", # "so will not avoid conflicts with reserved method names ", # "because a method named after the primary key column ", # "itself must also be created."; # } # # no strict 'refs'; # *{"${class}::$name"} = \&{"${class}::$method"}; # } # } #} } $self->_clear_column_generated_values; # Initialize method name hashes $self->column_accessor_method_names; $self->column_mutator_method_names; $self->column_rw_method_names; # This rule is relaxed for now... # Must have an rw accessor for every column #my $columns = $self->columns_ordered; # #unless(keys %methods == @$columns) #{ # Carp::croak "Rose::DB::Object-derived objects are required to have ", # "a 'get_set' method for every column. This class (", # $self->class, ") has ", scalar @$columns, "column", # (@$columns == 1 ? '' : 's'), " and ", scalar keys %methods, # " method", (scalar keys %methods == 1 ? '' : 's'); #} return; } sub make_nonpersistent_column_methods { my($self) = shift; my(%args) = @_; my $class = $self->class; $args{'target_class'} = $class; foreach my $column ($self->nonpersistent_columns_ordered) { unless($column->validate_specification) { Carp::croak "Column specification for column '", $column->name, "' in class ", $self->class, " is invalid: ", $column->error; } my $name = $column->name; my $method; foreach my $type ($column->auto_method_types) { $method = $self->method_name_from_column_name($name, $type) or Carp::croak "No method name defined for column '$name' ", "method type '$type'"; if(my $reason = $self->method_name_is_reserved($method, $class)) { Carp::croak "Cannot create method '$method' - $reason ", "Use alias_column() to map it to another name." } $column->method_name($type => $method); } #$Debug && warn $self->class, " - make methods for column $name\n"; $column->make_methods(%args); } $self->_clear_nonpersistent_column_generated_values; # Initialize method name hashes $self->nonpersistent_column_accessor_method_names; return; } sub make_foreign_key_methods { my($self) = shift; my(%args) = @_; #$self->retry_deferred_foreign_keys; my $class = $self->class; my $meta_class = ref $self; $args{'target_class'} = $class; foreach my $foreign_key ($self->foreign_keys) { #next unless($foreign_key->is_ready_to_make_methods); foreach my $type ($foreign_key->auto_method_types) { my $method = $foreign_key->method_name($type) || $foreign_key->build_method_name_for_type($type) || Carp::croak "No method name defined for foreign key '", $foreign_key->name, "' method type '$type'"; if(my $reason = $self->method_name_is_reserved($method, $class)) { Carp::croak "Cannot create method '$method' - $reason ", "Choose a different foreign key name." } $foreign_key->method_name($type => $method); } if($self->auto_load_related_classes && (my $fclass = $foreign_key->class)) { unless($fclass->isa('Rose::DB::Object')) { my $error; TRY: { local $@; eval "require $fclass"; $error = $@; } $Debug && print STDERR "FK REQUIRES $fclass - $error\n"; if($error) { # XXX: Need to distinguish recoverable errors from unrecoverable errors if($error !~ /\.pm in \@INC/ && !UNIVERSAL::isa($error, 'Rose::DB::Object::Exception::ClassNotReady')) { Carp::confess "Could not load $fclass - $error"; } } } } # We may need to defer the creation of some foreign key methods until # all the required pieces are loaded. if($foreign_key->is_ready_to_make_methods) { if($Debug && !$args{'preserve_existing'}) { warn $self->class, " - make methods for foreign key ", $foreign_key->name, "\n"; } $foreign_key->make_methods(%args); } else { # Confirm that no info is missing. This prevents an improperly # configured foreign_key from being deferred "forever" $foreign_key->sanity_check; $Debug && warn $self->class, " - defer foreign key ", $foreign_key->name, "\n"; $foreign_key->deferred_make_method_args(\%args); $meta_class->add_deferred_foreign_key($foreign_key); } # Keep foreign keys and their corresponding relationships in sync. my $fk_id = $foreign_key->id; my $fk_rel_type = $foreign_key->relationship_type; foreach my $relationship ($self->relationships) { next unless($relationship->type eq $fk_rel_type); if($fk_id eq $relationship->id) { $relationship->foreign_key($foreign_key); } } } $self->retry_deferred_foreign_keys; return; } our @Deferred_Tasks; sub deferred_tasks { return wantarray ? @Deferred_Tasks : \@Deferred_Tasks; } sub add_deferred_tasks { my($class) = shift; ARG: foreach my $arg (@_) { foreach my $task (@Deferred_Tasks) { next ARG if($arg->{'class'} eq $task->{'class'} && $arg->{'method'} eq $task->{'method'}); } push(@Deferred_Tasks, $arg); } } sub add_deferred_task { shift->add_deferred_tasks(@_) } sub has_deferred_tasks { my($self) = shift; my $class = $self->class; my $meta_class = ref $self; # Search among the deferred tasks too (icky) foreach my $task ($meta_class->deferred_tasks) { if($task->{'class'} eq $class) { return 1; } } return 0; } sub retry_deferred_tasks { my($self) = shift; my @tasks; foreach my $task (@Deferred_Tasks) { my $code = $task->{'code'}; my $check = $task->{'check'}; $code->(); unless($check->()) { push(@tasks, $task); } } if(join(',', sort @Deferred_Tasks) ne join(',', sort @tasks)) { @Deferred_Tasks = @tasks; } } our @Deferred_Foreign_Keys; sub deferred_foreign_keys { return wantarray ? @Deferred_Foreign_Keys : \@Deferred_Foreign_Keys; } sub has_deferred_foreign_keys { my($self) = shift; my $class = $self->class; my $meta_class = ref $self; foreach my $fk ($meta_class->deferred_foreign_keys) { return 1 if($fk->class eq $class); } # Search among the deferred tasks too (icky) foreach my $task ($meta_class->deferred_tasks) { if($task->{'class'} eq $class && $task->{'method'} eq 'auto_init_foreign_keys') { return 1; } } return 0; } sub has_outstanding_metadata_tasks { my($self) = shift; return $self->{'has_outstanding_metadata_tasks'} = shift if(@_); if(defined $self->{'has_outstanding_metadata_tasks'}) { return $self->{'has_outstanding_metadata_tasks'}; } if($self->has_deferred_foreign_keys || $self->has_deferred_relationships || $self->has_deferred_tasks) { return $self->{'has_outstanding_metadata_tasks'} = 1; } return $self->{'has_outstanding_metadata_tasks'} = 0; } sub add_deferred_foreign_keys { my($class) = shift; my $check = 0; ARG: foreach my $arg (@_) { foreach my $fk (@Deferred_Foreign_Keys) { next ARG if($fk->id eq $arg->id); } $arg->parent->has_outstanding_metadata_tasks(1); push(@Deferred_Foreign_Keys, $arg); } } sub add_deferred_foreign_key { shift->add_deferred_foreign_keys(@_) } sub retry_deferred_foreign_keys { my($self) = shift; my $meta_class = ref $self; my @foreign_keys; # Check to see if any deferred foreign keys are ready now foreach my $foreign_key ($meta_class->deferred_foreign_keys) { # XXX: this is not necessary, so it's commented out for now. # Try to rebuild the relationship using the convention manager, since # new info may be available now. Otherwise, leave it as-is. # $foreign_key = # $self->convention_manager->auto_foreign_key( # $def_fk->name, scalar $def_fk->spec_hash) || # $def_fk; if($foreign_key->is_ready_to_make_methods) { $Debug && warn $foreign_key->parent->class, " - (Retry) make methods for foreign key ", $foreign_key->name, "\n"; my $args = $foreign_key->deferred_make_method_args || {}; $foreign_key->make_methods(%$args); #, preserve_existing => 1); } else { push(@foreign_keys, $foreign_key); } } if(join(',', sort @Deferred_Foreign_Keys) ne join(',', sort @foreign_keys)) { @Deferred_Foreign_Keys = @foreign_keys; } # Retry relationship auto-init for all other classes foreach my $class ($self->registered_classes) { my $meta = $class->meta; next unless($meta->allow_auto_initialization && $meta->has_outstanding_metadata_tasks); $meta->auto_init_relationships(%{ $meta->auto_init_args || {} }, restore_types => 1); } } sub make_relationship_methods { my($self) = shift; my(%args) = @_; #$self->retry_deferred_relationships; my $meta_class = ref $self; my $class = $self->class; $args{'target_class'} = $class; my $preserve_existing_arg = $args{'preserve_existing'}; REL: foreach my $relationship ($self->relationships) { next if($args{'name'} && $relationship->name ne $args{'name'}); #next unless($relationship->is_ready_to_make_methods); foreach my $type ($relationship->auto_method_types) { my $method = $relationship->method_name($type) || $relationship->build_method_name_for_type($type) || Carp::croak "No method name defined for relationship '", $relationship->name, "' method type '$type'"; if(my $reason = $self->method_name_is_reserved($method, $class)) { Carp::croak "Cannot create method '$method' - $reason ", "Choose a different relationship name." } $relationship->method_name($type => $method); # Initialize/reset preserve_existing flag if($self->is_auto_initializating) { $args{'preserve_existing'} = $preserve_existing_arg || $self->allow_auto_initialization; } delete $args{'replace_existing'} if($args{'preserve_existing'}); # If a corresponding foreign key exists, the preserve any existing # methods with the same names. This is a crude way to ensure that we # can have a foreign key and a corresponding relationship without any # method name clashes. if($relationship->can('id')) { my $rel_id = $relationship->id; FK: foreach my $fk ($self->foreign_keys) { if($rel_id eq $fk->id) { $args{'preserve_existing'} = 1; delete $args{'replace_existing'}; last FK; } } } } if($self->auto_load_related_classes) { if($relationship->can('class')) { my $fclass = $relationship->class; unless($fclass->isa('Rose::DB::Object') && $fclass->meta->is_initialized) { my $error; TRY: { local $@; eval "require $fclass"; $error = $@; } $Debug && print STDERR "REL ", $relationship->name, " REQUIRES $fclass - $error\n"; if($error) { # XXX: Need to distinguish recoverable errors from unrecoverable errors if($error !~ /\.pm in \@INC/ && !UNIVERSAL::isa($error, 'Rose::DB::Object::Exception::ClassNotReady')) #if($error =~ /syntax error at |requires explicit package name|not allowed while "strict|already has a relationship named|Can't modify constant item/) { Carp::confess "Could not load $fclass - $error"; } } } } if($relationship->can('map_class')) { my $map_class = $relationship->map_class; unless($map_class->isa('Rose::DB::Object') && $map_class->meta->is_initialized) { my $error; TRY: { local $@; eval "require $map_class"; $error = $@; } $Debug && print STDERR "REL ", $relationship->name, " REQUIRES $map_class - $error\n"; if($error) { # XXX: Need to distinguish recoverable errors from unrecoverable errors if($error !~ /\.pm in \@INC/ && !UNIVERSAL::isa($error, 'Rose::DB::Object::Exception::ClassNotReady')) #if($error =~ /syntax error at |requires explicit package name|not allowed while "strict|already has a relationship named|Can't modify constant item/) { Carp::confess "Could not load $map_class - $error"; } } } } } # We may need to defer the creation of some relationship methods until # all the required pieces are loaded. if($relationship->is_ready_to_make_methods) { if($Debug && !$args{'preserve_existing'}) { warn $self->class, " - make methods for relationship ", $relationship->name, "\n"; } $relationship->make_methods(%args); } elsif(!$relationship->can('foreign_key') || !$relationship->foreign_key) { # Confirm that no info is missing. This prevents an improperly # configured relationship from being deferred "forever" $relationship->sanity_check; $Debug && warn $self->class, " - defer relationship ", $relationship->name, "\n"; $relationship->deferred_make_method_args(\%args); $meta_class->add_deferred_relationship($relationship); } } #$self->retry_deferred_relationships; return; } our @Deferred_Relationships; sub deferred_relationships { return wantarray ? @Deferred_Relationships : \@Deferred_Relationships; } sub has_deferred_relationships { my($self) = shift; my $class = $self->class; my $meta_class = ref $self; foreach my $rel ($meta_class->deferred_relationships) { if(($rel->can('class') && $rel->class eq $class) || ($rel->can('map_class') && $rel->map_class eq $class)) { return 1; } } # Search among the deferred tasks too (icky) foreach my $task ($meta_class->deferred_tasks) { if($task->{'class'} eq $class && $task->{'method'} eq 'auto_init_relationships') { return 1; } } return 0; } sub add_deferred_relationships { my($class) = shift; ARG: foreach my $arg (@_) { foreach my $rel (@Deferred_Relationships) { next ARG if($rel->id eq $arg->id); } push(@Deferred_Relationships, $arg); } } sub add_deferred_relationship { shift->add_deferred_relationships(@_) } sub retry_deferred_relationships { my($self) = shift; my $meta_class = ref $self; my @relationships; # Check to see if any deferred relationships are ready now foreach my $relationship ($self->deferred_relationships) { # Try to rebuild the relationship using the convention manager, since # new info may be available now. Otherwise, leave it as-is. my $rebuild_rel = $self->convention_manager->auto_relationship( $relationship->name, ref $relationship, scalar $relationship->spec_hash); if($rebuild_rel) { # XXX: This is pretty evil. I need some sort of copy operator, but # XXX: a straight hash copy will do for now... %$relationship = %$rebuild_rel; } if($relationship->is_ready_to_make_methods) { $Debug && warn $relationship->parent->class, " - (Retry) make methods for relationship ", $relationship->name, "\n"; my $args = $relationship->deferred_make_method_args || {}; $args->{'preserve_existing'} = 1; delete $args->{'replace_existing'}; $relationship->make_methods(%$args); # Reassign to list in case we rebuild above $relationship->parent->relationship($relationship->name => $relationship); } else { push(@relationships, $relationship); } } if(join(',', sort @Deferred_Relationships) ne join(',', sort @relationships)) { @Deferred_Relationships = @relationships; } # Retry relationship auto-init for all other classes #foreach my $class ($self->registered_classes) #{ # next unless($class->meta->allow_auto_initialization && $meta->has_outstanding_metadata_tasks); # $self->auto_init_relationships(restore_types => 1); #} } sub make_methods { my($self) = shift; $self->make_column_methods(@_); $self->make_nonpersistent_column_methods(@_); $self->make_foreign_key_methods(@_); $self->make_relationship_methods(@_); } sub generate_primary_key_values { my($self, $db) = @_; if(my $code = $self->primary_key_generator) { return $code->($self, $db); } my @ids; my $seqs = $self->fq_primary_key_sequence_names(db => $db); if($seqs && @$seqs) { my $i = 0; foreach my $seq (@$seqs) { $i++; unless(defined $seq) { push(@ids, undef); next; } my $id = $db->next_value_in_sequence($seq); unless($id) { $self->error("Could not generate primary key for ", $self->class, " column '", ($self->primary_key_column_names)[$i], "' by selecting the next value in the sequence ", "'$seq' - $@"); return undef; } push(@ids, $id); } return @ids; } else { return $db->generate_primary_key_values(scalar @{$self->primary_key_column_names}); } } sub generate_primary_key_value { my @ids = shift->generate_primary_key_values(@_); return $ids[0]; } sub generate_primary_key_placeholders { my($self, $db) = @_; return $db->generate_primary_key_placeholders(scalar @{$self->primary_key_column_names}); } sub primary_key_column_accessor_names { my($self) = shift; if($self->{'primary_key_column_accessor_names'}) { return @{$self->{'primary_key_column_accessor_names'}}; } my @column_names = $self->primary_key_column_names; my @columns = grep { defined } map { $self->column($_) } @column_names; return unless(@column_names == @columns); # not ready yet my @methods = grep { defined } map { $self->column_accessor_method_name($_) } @column_names; return unless(@methods); $self->{'primary_key_column_accessor_names'} = \@methods; return @methods; } sub primary_key_column_mutator_names { my($self) = shift; if($self->{'primary_key_column_mutator_names'}) { return @{$self->{'primary_key_column_mutator_names'}}; } my @column_names = $self->primary_key_column_names; my @columns = grep { defined } map { $self->column($_) } @column_names; return unless(@column_names == @columns); # not ready yet my @methods = grep { defined } map { $self->column_mutator_method_name($_) } @column_names; return unless(@methods); $self->{'primary_key_column_mutator_names'} = \@methods; return @methods; } sub fq_primary_key_sequence_names { my($self, %args) = @_; my $db_id = $args{'db'}{'id'} || ($self->{'db_id'} ||= $self->init_db_id); if(defined $self->{'fq_primary_key_sequence_names'}{$db_id}) { my $seqs = $self->{'fq_primary_key_sequence_names'}{$db_id} or return; return wantarray ? @$seqs : $seqs; } my $db = $args{'db'} or die "Cannot generate fully-qualified primary key sequence name without db argument"; my @seqs = $self->primary_key_sequence_names($db); if(@seqs) { $self->primary_key->sequence_names(@seqs); # Add schema and catalog information only if it isn't present # XXX: crappy check - just looking for a '.' foreach my $seq (@seqs) { if(defined $seq && index($seq, '.') < 0) { $seq = $db->quote_identifier_for_sequence($self->select_catalog($db), $self->select_schema($db), $seq); } } $self->{'fq_primary_key_sequence_names'}{$db->{'id'}} = \@seqs; return wantarray ? @seqs : \@seqs; } return; } sub refresh_primary_key_sequence_names { my($self, $db) = @_; my $db_id = UNIVERSAL::isa($db, 'Rose::DB') ? $db->id : $db; $self->{'fq_primary_key_sequence_names'}{$db_id} = undef; $self->{'primary_key_sequence_names'}{$db_id} = undef; return; } sub primary_key_sequence_names { my($self) = shift; my($db, $db_id); $db = shift if(UNIVERSAL::isa($_[0], 'Rose::DB')); $db_id = $db ? $db->{'id'} : $self->init_db_id; # Set pk sequence names if(@_) { # Clear fully-qualified pk values $self->{'fq_primary_key_sequence_names'}{$db_id} = undef; my $ret = $self->{'primary_key_sequence_names'}{$db_id} = (@_ == 1 && ref $_[0]) ? $_[0] : [ @_ ]; # Push down into pk metadata object too $self->primary_key->sequence_names(($db ? $db : ()), @$ret); return wantarray ? @$ret : $ret; } if($self->{'primary_key_sequence_names'}{$db_id}) { my $ret = $self->{'primary_key_sequence_names'}{$db_id}; return wantarray ? @$ret : $ret; } # Init pk sequence names # Start by considering the list of sequence names stored in the # primary key metadata object my @pks = $self->primary_key_column_names; my $seqs = $self->primary_key->sequence_names($db); my @seqs; if($seqs) { # If each pk column has a defined sequence name, accept them as-is if(@pks == grep { defined } @$seqs) { $self->{'primary_key_sequence_names'}{$db_id} = $seqs; return wantarray ? @$seqs : $seqs; } else # otherwise, use them as a starting point { @seqs = @$seqs; } } unless($db) { die "Cannot generate primary key sequence name without db argument"; } my $cm = $self->convention_manager; my $table = $self->table or Carp::croak "Cannot generate primary key sequence name without table name"; my $i = 0; foreach my $column ($self->primary_key_columns) { my $seq; # Go the extra mile and look up the sequence name (if any) for scalar # pk columns. These pk columns were probably set using the columns() # shortcut $meta->columns(qw(foo bar baz)) rather than the "long way" # with type information. if($column->type eq 'scalar') { $seq = $self->_sequence_name($db, $self->select_catalog($db), $self->select_schema($db), $table, $column); } # Set auto-created serial column sequence names elsif($column->type =~ /^(?:big)?serial$/ && $db->use_auto_sequence_name) { $seq = $cm->auto_column_sequence_name($table, $column, $db); } unless(exists $seqs[$i] && defined $seqs[$i]) { $seqs[$i] = $seq if(defined $seq); } $i++; } # Only save if it looks like the class setup is finished if($self->is_initialized) { $self->{'primary_key_sequence_names'}{$db->{'id'}} = \@seqs; } return wantarray ? @seqs : \@seqs; } sub _sequence_name { my($self, $db, $catalog, $schema, $table, $column) = @_; # XXX: This is only beneficial in PostgreSQL right now return unless($db->driver eq 'pg'); $table = lc $table if($db->likes_lowercase_table_names); my($col_info, $error); TRY: { local $@; eval { my $dbh = $db->dbh; local $dbh->{'RaiseError'} = 0; local $dbh->{'PrintError'} = 0; my $sth = $dbh->column_info($catalog, $schema, $table, $column) or return; $sth->execute; $col_info = $sth->fetchrow_hashref; $sth->finish; }; $error = $@; } return if($error || !$col_info); $db->refine_dbi_column_info($col_info, $self); my $seq = $col_info->{'rdbo_default_value_sequence_name'}; my $implicit_schema = $db->default_implicit_schema; # Strip off default implicit schema unless a schema is explicitly specified if(defined $seq && defined $implicit_schema && !defined $schema) { $seq =~ s/^$implicit_schema\.//; } return $seq; } sub column_names { my($self) = shift; $self->{'column_names'} ||= [ map { $_->name } $self->columns_ordered ]; return wantarray ? @{$self->{'column_names'}} : $self->{'column_names'}; } sub nonpersistent_column_names { my($self) = shift; $self->{'nonpersistent_column_names'} ||= [ map { $_->name } $self->nonpersistent_columns_ordered ]; return wantarray ? @{$self->{'nonpersistent_column_names'}} : $self->{'nonpersistent_column_names'}; } sub nonlazy_column_names { my($self) = shift; $self->{'nonlazy_column_names'} ||= [ map { $_->name } $self->nonlazy_columns ]; return wantarray ? @{$self->{'nonlazy_column_names'}} : $self->{'nonlazy_column_names'}; } sub lazy_column_names { my($self) = shift; $self->{'lazy_column_names'} ||= [ map { $_->name } $self->lazy_columns ]; return wantarray ? @{$self->{'lazy_column_names'}} : $self->{'lazy_column_names'}; } sub nonlazy_column_names_string_sql { my($self, $db) = @_; return $self->{'nonlazy_column_names_string_sql'}{$db->{'id'}} ||= join(', ', map { $_->name_sql($db) } $self->nonlazy_columns); } sub column_names_string_sql { my($self, $db) = @_; return $self->{'column_names_string_sql'}{$db->{'id'}} ||= join(', ', map { $_->name_sql($db) } $self->columns_ordered); } sub column_names_sql { my($self, $db) = @_; my $list = $self->{'column_names_sql'}{$db->{'id'}} ||= [ map { $_->name_sql($db) } $self->columns_ordered ]; return wantarray ? @$list : $list; } sub select_nonlazy_columns_string_sql { my($self, $db) = @_; return $self->{'select_nonlazy_columns_string_sql'}{$db->{'id'}} ||= join(', ', @{ scalar $self->select_nonlazy_columns_sql($db) }); } sub select_columns_string_sql { my($self, $db) = @_; return $self->{'select_columns_string_sql'}{$db->{'id'}} ||= join(', ', @{ scalar $self->select_columns_sql($db) }); } sub select_columns_sql { my($self, $db) = @_; my $list = $self->{'select_columns_sql'}{$db->{'id'}}; unless($list) { my $table = $self->table; if($self->sql_qualify_column_names_on_load) { $list = [ map { $_->select_sql($db, $table) } $self->columns_ordered ]; } else { $list = [ map { $_->select_sql($db) } $self->columns_ordered ]; } $self->{'select_columns_sql'}{$db->{'id'}} = $list; } return wantarray ? @$list : $list; } sub select_nonlazy_columns_sql { my($self, $db) = @_; my $list = $self->{'select_nonlazy_columns_sql'}{$db->{'id'}}; unless($list) { my $table = $self->table; if($self->sql_qualify_column_names_on_load) { $list = [ map { $_->select_sql($db, $table) } $self->nonlazy_columns ]; } else { $list = [ map { $_->select_sql($db) } $self->nonlazy_columns ]; } $self->{'select_nonlazy_columns_sql'}{$db->{'id'}} = $list; } return wantarray ? @$list : $list; } sub method_column { my($self, $method) = @_; unless(defined $self->{'method_columns'}) { foreach my $column ($self->columns_ordered) { foreach my $type ($column->defined_method_types) { if(my $method = $column->method_name($type)) { $self->{'method_column'}{$method} = $column; } } } } return $self->{'method_column'}{$method}; } sub column_rw_method_names { my($self) = shift; $self->{'column_rw_method_names'} ||= [ map { $self->column_rw_method_name($_) } $self->column_names ]; return wantarray ? @{$self->{'column_rw_method_names'}} : $self->{'column_rw_method_names'}; } sub column_accessor_method_names { my($self) = shift; $self->{'column_accessor_method_names'} ||= [ map { $self->column_accessor_method_name($_) } $self->column_names ]; return wantarray ? @{$self->{'column_accessor_method_names'}} : $self->{'column_accessor_method_names'}; } sub nonpersistent_column_accessor_method_names { my($self) = shift; $self->{'nonpersistent_column_accessor_method_names'} ||= [ map { $self->nonpersistent_column_accessor_method_name($_) } $self->nonpersistent_column_names ]; return wantarray ? @{$self->{'nonpersistent_column_accessor_method_names'}} : $self->{'nonpersistent_column_accessor_method_names'}; } sub nonlazy_column_accessor_method_names { my($self) = shift; $self->{'nonlazy_column_accessor_method_names'} ||= [ map { $self->column_accessor_method_name($_) } $self->nonlazy_column_names ]; return wantarray ? @{$self->{'nonlazy_column_accessor_method_names'}} : $self->{'nonlazy_column_accessor_method_names'}; } sub column_mutator_method_names { my($self) = shift; $self->{'column_mutator_method_names'} ||= [ map { $self->column_mutator_method_name($_) } $self->column_names ]; return wantarray ? @{$self->{'column_mutator_method_names'}} : $self->{'column_mutator_method_names'}; } sub nonpersistent_column_mutator_method_names { my($self) = shift; $self->{'nonpersistent_column_mutator_method_names'} ||= [ map { $self->nonpersistent_column_mutator_method_name($_) } $self->nonpersistent_column_names ]; return wantarray ? @{$self->{'nonpersistent_column_mutator_method_names'}} : $self->{'nonpersistent_column_mutator_method_names'}; } sub nonlazy_column_mutator_method_names { my($self) = shift; $self->{'nonlazy_column_mutator_method_names'} ||= [ map { $self->column_mutator_method_name($_) } $self->nonlazy_column_names ]; return wantarray ? @{$self->{'nonlazy_column_mutator_method_names'}} : $self->{'nonlazy_column_mutator_method_names'}; } sub column_db_value_hash_keys { my($self) = shift; $self->{'column_db_value_hash_keys'} ||= { map { $_->mutator_method_name => $_->db_value_hash_key } $self->columns_ordered }; return wantarray ? %{$self->{'column_db_value_hash_keys'}} : $self->{'column_db_value_hash_keys'}; } sub nonlazy_column_db_value_hash_keys { my($self) = shift; $self->{'nonlazy_column_db_value_hash_keys'} ||= { map { $_->mutator_method_name => $_->db_value_hash_key } $self->nonlazy_columns }; return wantarray ? %{$self->{'nonlazy_column_db_value_hash_keys'}} : $self->{'nonlazy_column_db_value_hash_keys'}; } sub primary_key_column_db_value_hash_keys { my($self) = shift; $self->{'primary_key_column_db_value_hash_keys'} ||= [ map { $_->db_value_hash_key } $self->primary_key_columns ]; return wantarray ? @{$self->{'primary_key_column_db_value_hash_keys'}} : $self->{'primary_key_column_db_value_hash_keys'}; } sub alias_column { my($self, $name, $new_name) = @_; Carp::croak "Usage: alias_column(column name, new name)" unless(@_ == 3); Carp::croak "No such column '$name' in table ", $self->table unless($self->{'columns'}{$name}); Carp::cluck "Pointless alias for '$name' to '$new_name' for table ", $self->table unless($name ne $new_name); # XXX: Allow primary keys to be aliased # XXX: Was disabled because the Manager was not happy with this. #foreach my $column ($self->primary_key_column_names) #{ # if($name eq $column) # { # Carp::croak "Primary key columns cannot be aliased (the culprit: '$name')"; # } #} $self->_clear_column_generated_values; if(my $column = $self->column($name)) { $column->method_name($new_name); } $self->{'column_aliases'}{$name} = $new_name; } sub column_aliases { return $_[0]->{'column_aliases'} unless(@_ > 1); return $_[0]->{'column_aliases'} = (ref $_[1] eq 'HASH') ? $_[1] : { @_[1 .. $#_] }; } sub column_accessor_method_name { $_[0]->{'column_accessor_method'}{$_[1]} ||= ($_[0]->column($_[1]) ? $_[0]->column($_[1])->accessor_method_name : undef); } sub nonpersistent_column_accessor_method_name { $_[0]->{'nonpersistent_column_accessor_method'}{$_[1]} ||= ($_[0]->nonpersistent_column($_[1]) ? $_[0]->nonpersistent_column($_[1])->accessor_method_name : undef); } sub column_accessor_method_names_hash { shift->{'column_accessor_method'} } sub nonpersistent_column_accessor_method_names_hash { shift->{'nonpersistent_column_accessor_method'} } sub key_column_accessor_method_names_hash { my($self) = shift; return $self->{'key_column_accessor_method'} if($self->{'key_column_accessor_method'}); foreach my $column (grep { ref } $self->primary_key_columns) { $self->{'key_column_accessor_method'}{$column->name} = $column->accessor_method_name; } foreach my $uk ($self->unique_keys) { foreach my $column (grep { ref } $uk->columns) { $self->{'key_column_accessor_method'}{$column->name} = $column->accessor_method_name; } } return $self->{'key_column_accessor_method'}; } sub column_mutator_method_name { $_[0]->{'column_mutator_method'}{$_[1]} ||= ($_[0]->column($_[1]) ? $_[0]->column($_[1])->mutator_method_name : undef); } sub nonpersistent_column_mutator_method_name { $_[0]->{'nonpersistent_column_mutator_method'}{$_[1]} ||= ($_[0]->nonpersistent_column($_[1]) ? $_[0]->nonpersistent_column($_[1])->mutator_method_name : undef); } sub column_mutator_method_names_hash { shift->{'column_mutator_method'} } sub column_rw_method_name { $_[0]->{'column_rw_method'}{$_[1]} ||= $_[0]->column($_[1])->rw_method_name; } sub column_rw_method_names_hash { shift->{'column_rw_method'} } sub fq_table_sql { my($self, $db) = @_; return $self->{'fq_table_sql'}{$db->{'id'}} ||= join('.', grep { defined } ($self->select_catalog($db), $self->select_schema($db), $db->auto_quote_table_name($self->table))); } sub fqq_table_sql { my($self, $db) = @_; return $self->{'fq_table_sql'}{$db->{'id'}} ||= join('.', grep { defined } ($self->select_catalog($db), $self->select_schema($db), $db->quote_table_name($self->table))); } sub fq_table { my($self, $db) = @_; return $self->{'fq_table'}{$db->{'id'}} ||= join('.', grep { defined } ($self->select_catalog($db), $self->select_schema($db), $self->table)); } sub load_all_sql { my($self, $key_columns, $db) = @_; $key_columns ||= $self->primary_key_column_names; no warnings; return $self->{'load_all_sql'}{$db->{'id'}}{join("\0", @$key_columns)} ||= 'SELECT ' . $self->select_columns_string_sql($db) . ' FROM ' . $self->fq_table_sql($db) . ' WHERE ' . join(' AND ', map { my $c = $self->column($_); ($self->sql_qualify_column_names_on_load ? $db->auto_quote_column_with_table($c->name_sql, $self->table) : $c->name_sql($db)) . ' = ' . $c->query_placeholder_sql($db) } @$key_columns); } sub load_sql { my($self, $key_columns, $db) = @_; $key_columns ||= $self->primary_key_column_names; no warnings; return $self->{'load_sql'}{$db->{'id'}}{join("\0", @$key_columns)} ||= 'SELECT ' . $self->select_nonlazy_columns_string_sql($db) . ' FROM ' . $self->fq_table_sql($db) . ' WHERE ' . join(' AND ', map { my $c = $self->column($_); ($self->sql_qualify_column_names_on_load ? $db->auto_quote_column_with_table($c->name_sql, $self->table) : $c->name_sql($db)) . ' = ' . $c->query_placeholder_sql($db) } @$key_columns); } sub load_all_sql_with_null_key { my($self, $key_columns, $key_values, $db) = @_; my $i = 0; my $fq = $self->sql_qualify_column_names_on_load; my $table = $self->table; no warnings; return 'SELECT ' . $self->select_columns_string_sql($db) . ' FROM ' . $self->fq_table_sql($db) . ' WHERE ' . join(' AND ', map { my $c = $self->column($_); ($fq ? $db->auto_quote_column_with_table($c->name_sql, $table) : $c->name_sql($db)) . (defined $key_values->[$i++] ? ' = ' . $c->query_placeholder_sql : ' IS NULL') } @$key_columns); } sub load_sql_with_null_key { my($self, $key_columns, $key_values, $db) = @_; my $i = 0; my $fq = $self->sql_qualify_column_names_on_load; my $table = $self->table; no warnings; return 'SELECT ' . $self->select_nonlazy_columns_string_sql($db) . ' FROM ' . $self->fq_table_sql($db) . ' WHERE ' . join(' AND ', map { my $c = $self->column($_); ($fq ? $db->auto_quote_column_with_table($c->name_sql, $table) : $c->name_sql($db)) . (defined $key_values->[$i++] ? ' = ' . $c->query_placeholder_sql : ' IS NULL') } @$key_columns); } sub update_all_sql { my($self, $key_columns, $db) = @_; $key_columns ||= $self->primary_key_column_names; my $cache_key = "$db->{'id'}:" . join("\0", @$key_columns); return $self->{'update_all_sql'}{$cache_key} if($self->{'update_all_sql'}{$cache_key}); my %key = map { ($_ => 1) } @$key_columns; no warnings; return $self->{'update_all_sql'}{$cache_key} = 'UPDATE ' . $self->fq_table_sql($db) . " SET \n" . join(",\n", map { ' ' . $_->name_sql($db) . ' = ' . $_->update_placeholder_sql($db) } grep { !$key{$_->name} } $self->columns_ordered) . "\nWHERE " . join(' AND ', map { my $c = $self->column($_); $c->name_sql($db) . ' = ' . $c->query_placeholder_sql } @$key_columns); } use constant LAZY_LOADED_KEY => lazy_column_values_loaded_key(); sub update_sql { my($self, $obj, $key_columns, $db) = @_; $key_columns ||= $self->primary_key_column_names; my %key = map { ($_ => 1) } @$key_columns; no warnings 'uninitialized'; my @columns = grep { !$key{$_->name} && (!$_->lazy || $obj->{LAZY_LOADED_KEY()}{$_->name}) } $self->columns_ordered; my @exec; unless($self->dbi_requires_bind_param($db)) { my $method_name = $self->column_accessor_method_names_hash; foreach my $column (@columns) { my $method = $method_name->{$column->{'name'}}; push(@exec, $obj->$method()); } } return (($self->{'update_sql_prefix'}{$db->{'id'}} || $self->init_update_sql_prefix($db)) . join(",\n", map { ' ' . $_->name_sql($db) . ' = ' . $_->update_placeholder_sql($db) } @columns) . "\nWHERE " . join(' AND ', map { my $c = $self->column($_); $c->name_sql($db) . ' = ' . $c->query_placeholder_sql($db) } @$key_columns), \@exec, \@columns); } sub init_update_sql_prefix { my($self, $db) = @_; return $self->{'update_sql_prefix'}{$db->{'id'}} = 'UPDATE ' . $self->fq_table_sql($db) . " SET \n"; } sub update_changes_only_sql { my($self, $obj, $key_columns, $db) = @_; $key_columns ||= $self->primary_key_column_names; my %key = map { ($_ => 1) } @$key_columns; my @modified = map { $self->column($_) } grep { !$key{$_} } keys %{$obj->{MODIFIED_COLUMNS()} || {}}; return unless(@modified); no warnings; return ($self->{'update_sql_prefix'}{$db->{'id'}} ||= 'UPDATE ' . $self->fq_table_sql($db) . " SET \n") . join(",\n", map { ' ' . $_->name_sql($db) . ' = ' . $_->update_placeholder_sql($db) } @modified) . "\nWHERE " . join(' AND ', map { my $c = $self->column($_); $c->name_sql($db) . ' = ' . $c->query_placeholder_sql($db) } @$key_columns), [ map { my $m = $_->accessor_method_name; $obj->$m() } @modified ], \@modified; } # This is nonsensical right now because the primary key always has to be # non-null, and any update will use the primary key instead of a unique # key. But I'll leave the code here (commented out) just in case. # # sub update_all_sql_with_null_key # { # my($self, $key_columns, $key_values, $db) = @_; # # my %key = map { ($_ => 1) } @$key_columns; # my $i = 0; # # no warnings; # return # 'UPDATE ' . $self->fq_table_sql($db) . " SET \n" . # join(",\n", map { ' ' . $self->column($_)->name_sql($db) . ' = ?' } # grep { !$key{$_} } $self->column_names) . # "\nWHERE " . join(' AND ', map { defined $key_values->[$i++] ? "$_ = ?" : "$_ IS NULL" } # map { $self->column($_)->name_sql($db) } @$key_columns); # } # # Ditto for this version of update_sql_with_inlining which handles null keys # # sub update_sql_with_inlining # { # my($self, $obj, $key_columns, $key_values) = @_; # # my $db = $obj->db or Carp::croak "Missing db"; # # $key_columns ||= $self->primary_key_column_names; # # my %key = map { ($_ => 1) } @$key_columns; # # my @bind; # my @updates; # # foreach my $column (grep { !$key{$_} } $self->columns_ordered) # { # my $method = $self->column_method($column->name); # my $value = $obj->$method(); # # if($column->should_inline_value($db, $value)) # { # push(@updates, ' ' . $column->name_sql($db) . " = $value"); # } # else # { # push(@updates, ' ' . $column->name_sql($db) . ' = ?'); # push(@bind, $value); # } # } # # my $i = 0; # # no warnings; # return # ( # ($self->{'update_sql_with_inlining_start'} ||= # 'UPDATE ' . $self->fq_table_sql($db) . " SET \n") . # join(",\n", @updates) . "\nWHERE " . # join(' AND ', map { defined $key_values->[$i++] ? "$_ = ?" : "$_ IS NULL" } # map { $self->column($_)->name_sql($db) } @$key_columns), # \@bind # ); # } sub update_sql_with_inlining { my($self, $obj, $key_columns) = @_; my $db = $obj->db or Carp::croak "Missing db"; $key_columns ||= $self->primary_key_column_names; my %key = map { ($_ => 1) } @$key_columns; my(@bind, @updates, @bind_params); my $do_bind_params = $self->dbi_requires_bind_param($db); foreach my $column (grep { !$key{$_} && (!$_->{'lazy'} || $obj->{LAZY_LOADED_KEY()}{$_->{'name'}}) } $self->columns_ordered) { my $method = $self->column_accessor_method_name($column->name); my $value = $obj->$method(); if($column->should_inline_value($db, $value)) { push(@updates, $column->name_sql($db) . " = $value"); } else { push(@updates, $column->name_sql($db) . ' = ' . $column->update_placeholder_sql($db)); push(@bind, $value); if($do_bind_params) { push(@bind_params, $column->dbi_bind_param_attrs($db)); } } } my $i = 0; no warnings; return ( ($self->{'update_sql_with_inlining_start'}{$db->{'id'}} || $self->init_update_sql_with_inlining_start($db)) . join(",\n", @updates) . "\nWHERE " . join(' AND ', map { my $c = $self->column($_); $c->name_sql($db) . ' = ' . $c->query_placeholder_sql($db) } @$key_columns), \@bind, ($do_bind_params ? \@bind_params : ()) ); } sub init_update_sql_with_inlining_start { my($self, $db) = @_; return $self->{'update_sql_with_inlining_start'}{$db->{'id'}} = 'UPDATE ' . $self->fq_table_sql($db) . " SET \n"; } sub update_changes_only_sql_with_inlining { my($self, $obj, $key_columns) = @_; my $db = $obj->db or Carp::croak "Missing db"; $key_columns ||= $self->primary_key_column_names; my %key = map { ($_ => 1) } @$key_columns; my $modified = $obj->{MODIFIED_COLUMNS()}; my(@bind, @updates, @bind_params); my $do_bind_params = $self->dbi_requires_bind_param($db); foreach my $column (grep { !$key{$_->{'name'}} && $modified->{$_->{'name'}} } $self->columns_ordered) { my $method = $self->column_accessor_method_name($column->name); my $value = $obj->$method(); if($column->should_inline_value($db, $value)) { push(@updates, ' ' . $column->name_sql($db) . " = $value"); } else { push(@updates, $column->name_sql($db) . ' = ' . $column->update_placeholder_sql($db)); push(@bind, $value); if($do_bind_params) { push(@bind_params, $column->dbi_bind_param_attrs($db)); } } } return unless(@updates); my $i = 0; no warnings; return ( ($self->{'update_sql_with_inlining_start'}{$db->{'id'}} ||= 'UPDATE ' . $self->fq_table_sql($db) . " SET \n") . join(",\n", @updates) . "\nWHERE " . join(' AND ', map { my $c = $self->column($_); $c->name_sql($db) . ' = ' . $c->query_placeholder_sql($db) } @$key_columns), \@bind, ($do_bind_params ? \@bind_params : ()) ); } sub insert_sql { my($self, $db) = @_; no warnings; return $self->{'insert_sql'}{$db->{'id'}} ||= 'INSERT INTO ' . $self->fq_table_sql($db) . "\n(\n" . join(",\n", map { " $_" } $self->column_names_sql($db)) . "\n)\nVALUES\n(\n" . $self->insert_columns_placeholders_sql($db) . "\n)"; } sub insert_changes_only_sql { my($self, $obj, $db) = @_; my $modified = $obj->{MODIFIED_COLUMNS()} || {}; my @modified = grep { $modified->{$_->{'name'}} || $_->default_exists } $self->columns_ordered; unless(@modified) { # Make a last-ditch attempt to insert with no modified columns # using the DEFAULT keyword on an arbitrary column. This works # in MySQL and PostgreSQL. if($db->supports_arbitrary_defaults_on_insert) { return 'INSERT INTO ' . $self->fq_table_sql($db) . ' (' . ($self->columns_ordered)[-1]->name_sql($db) . ') VALUES (DEFAULT)', []; } else { Carp::croak "Cannot insert row into table '", $self->table, "' - No columns have modified or default values"; } } no warnings; return ($self->{'insert_changes_only_sql_prefix'}{$db->{'id'}} || $self->init_insert_changes_only_sql_prefix($db)) . join(",\n", map { $_->name_sql($db) } @modified) . "\n)\nVALUES\n(\n" . join(",\n", map { $_->insert_placeholder_sql($db) } @modified) . "\n)", [ map { my $m = $_->accessor_method_name; $obj->$m() } @modified ], \@modified; } sub init_insert_changes_only_sql_prefix { my($self, $db) = @_; return $self->{'insert_changes_only_sql_prefix'}{$db->{'id'}} = 'INSERT INTO ' . $self->fq_table_sql($db) . "\n(\n"; ; } sub insert_columns_placeholders_sql { my($self, $db) = @_; return $self->{'insert_columns_placeholders_sql'}{$db->{'id'}} ||= join(",\n", map { ' ' . $_->insert_placeholder_sql($db) } $self->columns_ordered) } sub insert_and_on_duplicate_key_update_sql { my($self, $obj, $db, $changes_only) = @_; my(@columns, @names, @bind); if($obj->{STATE_IN_DB()}) { my %seen; @columns = $changes_only ? (map { $self->column($_) } grep { !$seen{$_}++ } ($self->primary_key_column_names, keys %{$obj->{MODIFIED_COLUMNS()} || {}})) : (grep { (!$_->{'lazy'} || $obj->{LAZY_LOADED_KEY()}{$_->{'name'}}) } $self->columns_ordered); @names = map { $_->name_sql($db) } @columns; foreach my $column (@columns) { my $method = $self->column_accessor_method_name($column->{'name'}); push(@bind, $obj->$method()); } } else { my %skip; my @key_columns = $self->primary_key_column_names; my @key_methods = $self->primary_key_column_accessor_names; my @key_values = grep { defined } map { $obj->$_() } @key_methods; unless(@key_values) { @skip{@key_columns} = (1) x @key_columns; } foreach my $uk ($self->unique_keys) { @key_columns = $uk->columns; @key_methods = map { $_->accessor_method_name } @key_columns; @key_values = grep { defined } map { $obj->$_() } @key_methods; unless(@key_values) { @skip{@key_columns} = (1) x @key_columns; } } @columns = $changes_only ? (map { $self->column($_) } grep { !$skip{"$_"} } keys %{$obj->{MODIFIED_COLUMNS()} || {}}) : (grep { !$skip{"$_"} && (!$_->{'lazy'} || $obj->{LAZY_LOADED_KEY()}{$_->{'name'}}) } $self->columns_ordered); @names = map { $_->name_sql($db) } @columns; foreach my $column (@columns) { my $method = $self->column_accessor_method_name($column->{'name'}); push(@bind, $obj->$method()); } } no warnings; return 'INSERT INTO ' . $self->fq_table_sql($db) . "\n(\n" . join(",\n", @names) . "\n)\nVALUES\n(\n" . join(",\n", map { $_->insert_placeholder_sql($db) } @columns) . "\n)\nON DUPLICATE KEY UPDATE\n" . join(",\n", map { $_->name_sql($db) . ' = ' . $_->update_placeholder_sql($db) } @columns), [ @bind, @bind ], [ @columns, @columns ]; } sub insert_sql_with_inlining { my($self, $obj) = @_; my $db = $obj->db or Carp::croak "Missing db"; my(@bind, @places, @bind_params); my $do_bind_params = $self->dbi_requires_bind_param($db); foreach my $column ($self->columns_ordered) { my $method = $self->column_accessor_method_name($column->name); my $value = $obj->$method(); if($column->should_inline_value($db, $value)) { push(@places, " $value"); } else { push(@places, $column->insert_placeholder_sql($db)); push(@bind, $value); if($do_bind_params) { push(@bind_params, $column->dbi_bind_param_attrs($db)); } } } return ( ($self->{'insert_sql_with_inlining_start'}{$db->{'id'}} || $self->init_insert_sql_with_inlining_start($db)) . join(",\n", @places) . "\n)", \@bind, ($do_bind_params ? \@bind_params : ()) ); } sub init_insert_sql_with_inlining_start { my($self, $db) = @_; $self->{'insert_sql_with_inlining_start'}{$db->{'id'}} = 'INSERT INTO ' . $self->fq_table_sql($db) . "\n(\n" . join(",\n", map { " $_" } $self->column_names_sql($db)) . "\n)\nVALUES\n(\n"; } sub insert_and_on_duplicate_key_update_with_inlining_sql { my($self, $obj, $db, $changes_only) = @_; my(@columns, @names); my $do_bind_params = $self->dbi_requires_bind_param($db); if($obj->{STATE_IN_DB()}) { my %seen; @columns = $changes_only ? (map { $self->column($_) } grep { !$seen{$_}++ } ($self->primary_key_column_names, keys %{$obj->{MODIFIED_COLUMNS()} || {}})) : (grep { (!$_->{'lazy'} || $obj->{LAZY_LOADED_KEY()}{$_->{'name'}}) } $self->columns_ordered); @names = map { $_->name_sql($db) } @columns; } else { my %skip; my @key_columns = $self->primary_key_column_names; my @key_methods = $self->primary_key_column_accessor_names; my @key_values = grep { defined } map { $obj->$_() } @key_methods; unless(@key_values) { @skip{@key_columns} = (1) x @key_columns; } foreach my $uk ($self->unique_keys) { @key_columns = $uk->columns; @key_methods = map { $_->accessor_method_name } @key_columns; @key_values = grep { defined } map { $obj->$_() } @key_methods; unless(@key_values) { @skip{@key_columns} = (1) x @key_columns; } } @columns = $changes_only ? (map { $self->column($_) } grep { !$skip{"$_"} } keys %{$obj->{MODIFIED_COLUMNS()} || {}}) : (grep { !$skip{"$_"} && (!$_->{'lazy'} || $obj->{LAZY_LOADED_KEY()}{$_->{'name'}}) } $self->columns_ordered); @names = map { $_->name_sql($db) } @columns; } my(@bind, @places, @bind_params); foreach my $column (@columns) { my $name = $column->{'name'}; my $method = $self->column_accessor_method_name($name); my $value = $obj->$method(); if($column->should_inline_value($db, $value)) { push(@places, [ $name, $column->inline_value_sql($value) ]); } else { push(@places, [ $name, $column->insert_placeholder_sql($_) ]); push(@bind, $value); if($do_bind_params) { push(@bind_params, $column->dbi_bind_param_attrs($db)); } } } no warnings; return 'INSERT INTO ' . $self->fq_table_sql($db) . "\n(\n" . join(",\n", @names) . "\n)\nVALUES\n(\n" . join(",\n", map { $_->[1] } @places) . "\n)\n" . "ON DUPLICATE KEY UPDATE\n" . join(",\n", map { "$_->[0] = $_->[1]" } @places), [ @bind, @bind ], ($do_bind_params ? \@bind_params : ()); } sub insert_changes_only_sql_with_inlining { my($self, $obj) = @_; my $db = $obj->db or Carp::croak "Missing db"; my $modified = $obj->{MODIFIED_COLUMNS()} || {}; my @modified = grep { $modified->{$_->{'name'}} || $_->default_exists } $self->columns_ordered; unless(@modified) { # Make a last-ditch attempt to insert with no modified columns # using the DEFAULT keyword on an arbitrary column. This works # in MySQL and PostgreSQL. if($db->supports_arbitrary_defaults_on_insert) { return 'INSERT INTO ' . $self->fq_table_sql($db) . ' (' . ($self->columns_ordered)[-1]->name_sql($db) . ') VALUES (DEFAULT)', []; } else { Carp::croak "Cannot insert row into table '", $self->table, "' - No columns have modified or default values"; } } my(@bind, @places, @bind_params); my $do_bind_params = $self->dbi_requires_bind_param($db); foreach my $column (@modified) { my $method = $self->column_accessor_method_name($column->name); my $value = $obj->$method(); if($column->should_inline_value($db, $value)) { push(@places, " $value"); } else { push(@places, $column->insert_placeholder_sql($db)); push(@bind, $value); if($do_bind_params) { push(@bind_params, $column->dbi_bind_param_attrs($db)); } } } return ( 'INSERT INTO ' . $self->fq_table_sql($db) . "\n(\n" . join(",\n", map { $_->name_sql($db) } @modified) . "\n)\nVALUES\n(\n" . join(",\n", @places) . "\n)", \@bind, ($do_bind_params ? \@bind_params : ()) ); } sub delete_sql { my($self, $db) = @_; return $self->{'delete_sql'}{$db->{'id'}} ||= 'DELETE FROM ' . $self->fq_table_sql($db) . ' WHERE ' . join(' AND ', map { $_->name_sql($db) . ' = ' . $_->query_placeholder_sql($db) } $self->primary_key_columns); } sub get_column_value { my($self, $object, $column) = @_; my $db = $object->db or Carp::confess $object->error; my $dbh = $db->dbh or Carp::confess $db->error; my $sql = $self->{'get_column_sql_tmpl'}{$db->{'id'}} || $self->init_get_column_sql_tmpl($db); $sql =~ s/__COLUMN__/$column->name_sql($db)/e; my @key_values = map { $object->$_() } map { $self->column_accessor_method_name($_) } $self->primary_key_column_names; my($value, $error); TRY: { local $@; eval { ($Debug || $Rose::DB::Object::Debug) && warn "$sql (@key_values)\n"; my $sth = $dbh->prepare($sql); $sth->execute(@key_values); $sth->bind_columns(\$value); $sth->fetch; }; $error = $@; } if($error) { Carp::croak "Could not lazily-load column value for column '", $column->name, "' - $error"; } return $value; } sub init_get_column_sql_tmpl { my($self, $db) = @_; my $key_columns = $self->primary_key_column_names; my %key = map { ($_ => 1) } @$key_columns; return $self->{'get_column_sql_tmpl'}{$db->{'id'}} = 'SELECT __COLUMN__ FROM ' . $self->fq_table_sql($db) . ' WHERE ' . join(' AND ', map { my $c = $self->column($_); $c->name_sql($db) . ' = ' . $c->query_placeholder_sql($db) } @$key_columns); } sub refresh_lazy_column_tracking { my($self) = shift; $self->_clear_column_generated_values; # Initialize method name hashes $self->column_accessor_method_names; $self->column_mutator_method_names; $self->column_rw_method_names; return $self->{'has_lazy_columns'} = grep { $_->lazy } $self->columns_ordered; } sub has_lazy_columns { my($self) = shift; return $self->{'has_lazy_columns'} if(defined $self->{'has_lazy_columns'}); return $self->{'has_lazy_columns'} = grep { $_->lazy } $self->columns_ordered; } sub prime_all_caches { my($class) = shift; foreach my $obj_class ($class->registered_classes) { $obj_class->meta->prime_caches(@_); } } sub prime_caches { my($self, %args) = @_; my @methods = qw(column_names num_columns nonlazy_column_names lazy_column_names column_rw_method_names column_accessor_method_names nonlazy_column_accessor_method_names column_mutator_method_names nonlazy_column_mutator_method_names nonlazy_column_db_value_hash_keys primary_key_column_db_value_hash_keys column_db_value_hash_keys column_accessor_method_names column_mutator_method_names column_rw_method_names key_column_accessor_method_names_hash); foreach my $method (@methods) { $self->$method(); } my $db = $args{'db'} || $self->class->init_db; $self->method_column('nonesuch'); $self->fq_primary_key_sequence_names(db => $db); @methods = qw(dbi_requires_bind_param fq_table fq_table_sql init_get_column_sql_tmpl delete_sql primary_key_sequence_names insert_sql init_insert_sql_with_inlining_start init_insert_changes_only_sql_prefix init_update_sql_prefix init_update_sql_with_inlining_start column_names_string_sql nonlazy_column_names_string_sql select_nonlazy_columns_string_sql select_columns_string_sql select_columns_sql select_nonlazy_columns_sql); foreach my $method (@methods) { $self->$method($db); } undef @methods; # reclaim memory? foreach my $key ($self->primary_key, $self->unique_keys) { foreach my $method (qw(update_all_sql load_sql load_all_sql)) { $self->$method(scalar $key->columns, $db); } } } sub _clear_table_generated_values { my($self) = shift; $self->{'fq_table'} = undef; $self->{'fq_table_sql'} = undef; $self->{'get_column_sql_tmpl'} = undef; $self->{'load_sql'} = undef; $self->{'load_all_sql'} = undef; $self->{'delete_sql'} = undef; $self->{'fq_primary_key_sequence_names'} = undef; $self->{'primary_key_sequence_names'} = undef; $self->{'insert_sql'} = undef; $self->{'insert_sql_with_inlining_start'} = undef; $self->{'insert_changes_only_sql_prefix'} = undef; $self->{'update_sql_prefix'} = undef; $self->{'update_sql_with_inlining_start'} = undef; $self->{'update_all_sql'} = undef; } sub _clear_column_generated_values { my($self) = shift; $self->{'fq_table'} = undef; $self->{'fq_table_sql'} = undef; $self->{'column_names'} = undef; $self->{'num_columns'} = undef; $self->{'nonlazy_column_names'} = undef; $self->{'lazy_column_names'} = undef; $self->{'column_names_sql'} = undef; $self->{'get_column_sql_tmpl'} = undef; $self->{'column_names_string_sql'} = undef; $self->{'nonlazy_column_names_string_sql'} = undef; $self->{'column_rw_method_names'} = undef; $self->{'column_accessor_method_names'} = undef; $self->{'nonlazy_column_accessor_method_names'} = undef; $self->{'column_mutator_method_names'} = undef; $self->{'nonlazy_column_mutator_method_names'} = undef; $self->{'nonlazy_column_db_value_hash_keys'} = undef; $self->{'primary_key_column_db_value_hash_keys'}= undef; $self->{'primary_key_column_names_or_aliases'} = undef $self->{'column_db_value_hash_keys'} = undef; $self->{'select_nonlazy_columns_string_sql'} = undef; $self->{'select_columns_string_sql'} = undef; $self->{'select_columns_sql'} = undef; $self->{'select_nonlazy_columns_sql'} = undef; $self->{'method_columns'} = undef; $self->{'column_accessor_method'} = undef; $self->{'key_column_accessor_method'} = undef; $self->{'column_rw_method'} = undef; $self->{'load_sql'} = undef; $self->{'load_all_sql'} = undef; $self->{'update_all_sql'} = undef; $self->{'update_sql_prefix'} = undef; $self->{'insert_sql'} = undef; $self->{'insert_sql_with_inlining_start'} = undef; $self->{'update_sql_with_inlining_start'} = undef; $self->{'insert_changes_only_sql_prefix'} = undef; $self->{'delete_sql'} = undef; $self->{'insert_columns_placeholders_sql'} = undef; $self->{'dbi_requires_bind_param'} = undef; $self->{'key_column_names'} = undef; } sub _clear_nonpersistent_column_generated_values { my($self) = shift; $self->{'nonpersistent_column_names'} = undef; $self->{'nonpersistent_column_accessor_method_names'} = undef; $self->{'nonpersistent_column_accessor_method'} = undef; $self->{'nonpersistent_column_mutator_method_names'} = undef; $self->{'nonpersistent_column_mutator_method'} = undef; } sub _clear_primary_key_column_generated_values { my($self) = shift; $self->{'primary_key_column_accessor_names'} = undef; $self->{'primary_key_column_mutator_names'} = undef; $self->{'key_column_accessor_method'} = undef; $self->{'primary_key_column_names_or_aliases'} = undef; $self->{'key_column_names'} = undef; } sub method_name_is_reserved { my($self, $name, $class) = @_; if(!defined $class && UNIVERSAL::isa($self, __PACKAGE__)) { $class ||= $self->class or die "Missing class!"; } Carp::confess "Missing method name argument in call to method_name_is_reserved()" unless(defined $name); if(index($name, PRIVATE_PREFIX) == 0) { return "The method prefix '", PRIVATE_PREFIX, "' is reserved." } elsif($name =~ /^(?:meta|dbh?|_?init_db|error|not_found|load|save|update|insert|delete|DESTROY)$/ || ($class->isa('Rose::DB::Object::Cached') && $name =~ /^(?:remember|forget(?:_all)?)$/)) { return "This method name is reserved for use by the $class API." } return 0; } sub method_name_from_column_name { my($self, $column_name, $method_type) = @_; my $column = $self->column($column_name) || $self->nonpersistent_column($column_name) or Carp::confess "No such column: $column_name"; return $self->method_name_from_column($column, $method_type); } sub method_name_from_column { my($self, $column, $method_type) = @_; my $default_name = $column->build_method_name_for_type($method_type); my $method_name = $column->method_name($method_type) || $self->convention_manager->auto_column_method_name($method_type, $column, $default_name, $self->class) || $default_name; if(my $code = $self->column_name_to_method_name_mapper) { my $column_name = $column->name; local $_ = $method_name; $method_name = $code->($self, $column_name, $method_type, $method_name); unless(defined $method_name) { Carp::croak "column_name_to_method_name_mapper() returned undef ", "for column name '$column_name' method type '$method_type'" } } return $method_name; } sub dbi_requires_bind_param { my($self, $db) = @_; return $self->{'dbi_requires_bind_param'}{$db->{'id'}} if(defined $self->{'dbi_requires_bind_param'}{$db->{'id'}}); foreach my $column ($self->columns_ordered) { if($column->dbi_requires_bind_param($db)) { return $self->{'dbi_requires_bind_param'}{$db->{'id'}} = 1; } } return $self->{'dbi_requires_bind_param'}{$db->{'id'}} = 0; } sub make_manager_class { my($self) = shift; my $error; TRY: { local $@; eval { eval $self->perl_manager_class(@_) }; $error = $@; } if($error) { Carp::croak "Could not make manager class - $error\nThe Perl code used was:\n\n", $self->perl_manager_class(@_); } } sub perl_manager_class { my($self) = shift; my %args; if(@_ == 1) { $args{'base_name'} = shift; } else { %args = @_; } $args{'base_name'} ||= $self->convention_manager->auto_manager_base_name; $args{'class'} ||= $self->convention_manager->auto_manager_class_name; unless($args{'class'} =~ /^\w+(?:::\w+)*$/) { no warnings; Carp::croak "Missing or invalid class", (length $args{'class'} ? ": '$args{'class'}'" : ''); } unless($args{'isa'}) { my @def = $self->default_manager_base_class; # may return multiple classes $args{'isa'} = (@def == 1 && ref $def[0]) ? $def[0] : \@def; } $args{'isa'} = [ $args{'isa'} ] unless(ref $args{'isa'}); my($isa, $ok); foreach my $class (@{$args{'isa'}}) { unless($class =~ /^\w+(?:::\w+)*$/) { no warnings; Carp::croak "Invalid isa class: '$class'"; } no strict 'refs'; $isa .= "use $class;\n" unless($class !~ /^Rose::DB::/ && %{"${class}::"}); $ok = 1 if(UNIVERSAL::isa($class, 'Rose::DB::Object::Manager')); } unless($ok) { Carp::croak "None of these classes inherit from Rose::DB::Object::Manager: ", join(', ', @{$args{'isa'}}); } $isa .= "our \@ISA = qw(@{$args{'isa'}});"; no strict 'refs'; if(@{"$args{'class'}::ISA"}) { Carp::croak "Can't override class $args{'class'} which already ", "appears to be defined."; } my $object_class = $self->class; return<<"EOF"; package $args{'class'}; use strict; $isa sub object_class { '$object_class' } __PACKAGE__->make_manager_methods('$args{'base_name'}'); 1; EOF } # # Automatic metadata setup # our $AUTOLOAD; sub DESTROY { } sub AUTOLOAD { if($AUTOLOAD =~ /::((?:auto_(?!helper)|(?:default_)?perl_)\w*)$/) { my $method = $1; my $self = shift; $self->init_auto_helper; unless($self->can($method)) { Carp::croak "No such method '$method' in class ", ref($self); } return $self->$method(@_); } Carp::confess "No such method: $AUTOLOAD"; } sub auto_helper_class { my($self) = shift; if(@_) { my $driver = lc shift; return $self->auto_helper_classes->{$driver} = shift if(@_); return $self->auto_helper_classes->{$driver}; } else { my $db = $self->db or die "Missing db"; return $self->auto_helper_classes->{$db->driver} || $self->auto_helper_classes->{'generic'} || Carp::croak "Don't know how to auto-initialize using driver '", $db->driver, "'"; } } my %Rebless; sub init_auto_helper { my($self) = shift; unless($self->isa($self->auto_helper_class)) { my $class = ref($self) || $self; my $auto_helper_class = $self->auto_helper_class; no strict 'refs'; unless(@{"${auto_helper_class}::ISA"}) { my $error; TRY: { local $@; eval "use $auto_helper_class"; $error = $@; } Carp::croak "Could not load '$auto_helper_class' - $error" if($error); } $self->original_class($class); REBLESS: # Do slightly evil re-blessing magic { # Check cache if(my $new_class = $Rebless{$class,$auto_helper_class}) { bless $self, $new_class; } else { # Special, simple case for Rose::DB::Object::Metadata if($class eq __PACKAGE__) { bless $self, $auto_helper_class; } else # Handle Rose::DB::Object::Metadata subclasses { # If this is a default Rose::DB driver class if(index($auto_helper_class, 'Rose::DB::') == 0) { # Make a new metadata class based on the current class my $new_class = $class . '::__RoseDBObjectMetadataPrivate__::' . $auto_helper_class; # Pull all the auto-helper's methods up into the new class, # unless they're already defined by the original class. This # is ugly, I know, but remember that it's all an implementation # detail that could change at any time :) IMPORT: { no strict 'refs'; local(*auto_symbol, *existing_symbol); while(my($name, $value) = each(%{"${auto_helper_class}::"})) { no warnings; next if($name =~ /^[A-Z]+$/); # skip BEGIN, DESTROY, etc. *auto_symbol = $value; *existing_symbol = *{"${class}::$name"}; if(defined &auto_symbol && !defined &existing_symbol) { $Debug && warn "IMPORT $name INTO $new_class FROM $auto_helper_class\n"; *{"${new_class}::$name"} = \&auto_symbol; } } } no strict 'refs'; @{"${new_class}::ISA"} = ($class, $auto_helper_class); bless $self, $new_class; } else { # Otherwise use the (apparently custom) metadata class bless $self, $auto_helper_class; } } # Cache value $Rebless{$class,$auto_helper_class} = ref $self; } } } return 1; } sub map_record_method_key { my($self, $method) = (shift, shift); if(@_) { return $self->{'map_record_method_key'}{$method} = shift; } return $self->{'map_record_method_key'}{$method}; } sub column_undef_overrides_default { my($self) = shift; if(@_) { return $self->{'column_undef_overrides_default'} = $_[0] ? 1 : 0; } return $self->{'column_undef_overrides_default'} if(defined $self->{'column_undef_overrides_default'}); return $self->{'column_undef_overrides_default'} = ref($self)->default_column_undef_overrides_default; } 1; __END__ =head1 NAME Rose::DB::Object::Metadata - Database object metadata. =head1 SYNOPSIS use Rose::DB::Object::Metadata; $meta = Rose::DB::Object::Metadata->new(class => 'Product'); # ...or... $meta = Rose::DB::Object::Metadata->for_class('Product'); # # Auto-initialization # $meta->table('products'); # optional if class name ends with "::Product" $meta->auto_initialize; # # ...or manual setup # $meta->setup ( table => 'products', columns => [ id => { type => 'int', primary_key => 1 }, name => { type => 'varchar', length => 255 }, description => { type => 'text' }, category_id => { type => 'int' }, status => { type => 'varchar', check_in => [ 'active', 'inactive' ], default => 'inactive', }, start_date => { type => 'datetime' }, end_date => { type => 'datetime' }, date_created => { type => 'timestamp', default => 'now' }, last_modified => { type => 'timestamp', default => 'now' }, ], unique_key => 'name', foreign_keys => [ category => { class => 'Category', key_columns => { category_id => 'id', } }, ], relationships => [ prices => { type => 'one to many', class => 'Price', column_map => { id => 'id_product' }, }, ], ); # # ...or even more verbose manual setup (old-style, not recommended) # $meta->table('products'); $meta->columns ( id => { type => 'int', primary_key => 1 }, name => { type => 'varchar', length => 255 }, description => { type => 'text' }, category_id => { type => 'int' }, status => { type => 'varchar', check_in => [ 'active', 'inactive' ], default => 'inactive', }, start_date => { type => 'datetime' }, end_date => { type => 'datetime' }, date_created => { type => 'timestamp', default => 'now' }, last_modified => { type => 'timestamp', default => 'now' }, ); $meta->unique_key('name'); $meta->foreign_keys ( category => { class => 'Category', key_columns => { category_id => 'id', } }, ); $meta->relationships ( prices => { type => 'one to many', class => 'Price', column_map => { id => 'id_product' }, }, ); ... =head1 DESCRIPTION L objects store information about a single table in a database: the name of the table, the names and types of columns, any foreign or unique keys, etc. These metadata objects are also responsible for supplying information to, and creating object methods for, the L-derived objects to which they belong. L objects also store information about the Ls that front the database tables they describe. What might normally be thought of as "class data" for the L is stored in the metadata object instead, in order to keep the method namespace of the L-derived class uncluttered. L objects are per-class singletons; there is one L object for each L-derived class. Metadata objects are almost never explicitly instantiated. Rather, there are automatically created and accessed through L-derived objects' L method. Once created, metadata objects can be populated manually or automatically. Both techniques are shown in the L above. The automatic mode works by asking the database itself for the information. There are some caveats to this approach. See the L section for more information. L objects contain three categories of objects that are responsible for creating object methods in L-derived classes: columns, foreign keys, and relationships. Column objects are subclasses of L. They are intended to store as much information as possible about each column. The particular class of the column object created for a database column is determined by a L. The column class, in turn, is responsible for creating the accessor/mutator method(s) for the column. When it creates these methods, the column class can use (or ignore) any information stored in the column object. Foreign key objects are of the class L. They store information about columns that refer to columns in other tables that are fronted by their own L-derived classes. A foreign key object is responsible for creating accessor method(s) to fetch the foreign object from the foreign table. Relationship objects are subclasses of L. They store information about a table's relationship to other tables that are fronted by their own L-derived classes. The particular class of the relationship object created for each relationship is determined by a L. A relationship object is responsible for creating accessor method(s) to fetch the foreign objects from the foreign table. =head1 AUTO-INITIALIZATION Manual population of metadata objects can be tedious and repetitive. Nearly all of the information stored in a L object exists in the database in some form. It's reasonable to consider simply extracting this information from the database itself, rather than entering it all manually. This automatic metadata extraction and subsequent L object population is called "auto-initialization." The example of auto-initialization in the L above is the most succinct variant: $meta->auto_initialize; As you can read in the documentation for the L method, that's shorthand for individually auto-initializing each part of the metadata object: columns, the primary key, unique keys, and foreign keys. But this brevity comes at a price. There are many caveats to auto-initialization. =head2 Caveats =head3 Start-Up Cost In order to retrieve the information required for auto-initialization, a database connection must be opened and queries must be run. Sometimes these queries include complex joins. All of these queries must be successfully completed before the L-derived objects that the L is associated with can be used. In an environment like L, server start-up time is precisely when you want to do any expensive operations. But in a command-line script or other short-lived process, the overhead of auto-initializing many metadata objects may become prohibitive. Also, don't forget that auto-initialization requires a database connection. L-derived objects can sometimes be useful even without a database connection (e.g., to temporarily store information that will never go into the database, or to synthesize data using object methods that have no corresponding database column). When using auto-initialization, this is not possible because the L-derived class won't even load if auto-initialization fails because it could not connect to the database. =head3 Detail First, auto-initialization cannot generate information that exists only in the mind of the programmer. The most common example is a relationship between two database tables that is either ambiguous or totally unexpressed by the database itself. For example, if a foreign key constraint does not exist, the relationship between rows in two different tables cannot be extracted from the database, and therefore cannot be auto-initialized. Even within the realm of information that, by all rights, should be available in the database, there are limitations. Although there is a handy L API for extracting metadata from databases, unfortunately, very few DBI drivers support it fully. Some don't support it at all. In almost all cases, some manual work is required to (often painfully) extract information from the database's "system tables" or "catalog." More troublingly, databases do not always provide all the metadata that a human could extract from the series of SQL statement that created the table in the first place. Sometimes, the information just isn't in the database to be extracted, having been lost in the process of table creation. Here's just one example. Consider this MySQL table definition: CREATE TABLE mytable ( id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, code CHAR(6), flag BOOLEAN NOT NULL DEFAULT 1, bits BIT(5) NOT NULL DEFAULT '00101', name VARCHAR(64) ); Now look at the metadata that MySQL 4 stores internally for this table: mysql> describe mytable; +-------+------------------+------+-----+---------+----------------+ | Field | Type | Null | Key | Default | Extra | +-------+------------------+------+-----+---------+----------------+ | id | int(10) unsigned | | PRI | NULL | auto_increment | | code | varchar(6) | YES | | NULL | | | flag | tinyint(1) | | | 1 | | | bits | tinyint(1) | | | 101 | | | name | varchar(64) | YES | | NULL | | +-------+------------------+------+-----+---------+----------------+ Note the following divergences from the "CREATE TABLE" statement. =over 4 =item * B This is troublesome if you want the traditional semantics of a CHAR type, namely the padding with spaces of values that are less than the column length. =item * B The default accessor method created for boolean columns has value coercion and formatting properties that are important to this data type. The default accessor created for integer columns lacks these constraints. The metadata object has no way of knowing that "flag" was supposed to be a boolean column, and thus makes the wrong kind of accessor method. It is thus possible to store, say, a value of "7" in the "flag" column. Oops. =item * B As in the case of the "flag" column above, this type change prevents the correct accessor method from being created. The default bitfield accessor method auto-inflates column values into L objects, which provide convenient methods for bit manipulation. The default accessor created for integer columns does no such thing. =back Remember that the auto-initialization process can only consider the metadata actually stored in the database. It has no access to the original "create table" statement. Thus, the semantics implied by the original table definition are effectively lost. Again, this is just one example of the kind of detail that can be lost in the process of converting your table definition into metadata that is stored in the database. Admittedly, MySQL is perhaps the worst case-scenario, having a well-deserved reputation for disregarding the wishes of table definitions. (The use of implicit default values for "NOT NULL" columns is yet another example.) Thankfully, there is a solution to this dilemma. Remember that auto-initialization is actually a multi-step process hiding behind that single call to the L method. To correct the sins of the database, simply break the auto-initialization process into its components. For example, here's how to correctly auto-initialize the "mytable" example above: # Make a first pass at column setup $meta->auto_init_columns; # Account for inaccuracies in DBD::mysql's column info by # replacing incorrect column definitions with new ones. # Fix CHAR(6) column that shows up as VARCHAR(6) $meta->column(code => { type => 'char', length => 6 }); # Fix BIT(5) column that shows up as TINYINT(1) $meta->column(bits => { type => 'bits', bits => 5, default => 101 }); # Fix BOOLEAN column that shows up as TINYINT(1) $meta->column(flag => { type => 'boolean', default => 1 }); # Do everything else $meta->auto_initialize; Note that L was called at the end. Without the C parameter, this call will preserve any existing metadata, rather than overwriting it, so our "corrections" are safe. =head3 Maintenance The price of auto-initialization is eternal vigilance. "What does that mean? Isn't auto-initialization supposed to save time and effort?" Well, yes, but at a cost. In addition to the caveats described above, consider what happens when a table definition changes. "Ah ha!" you say, "My existing class will automatically pick up the changes the next time it's loaded! Auto-initialization at its finest!" But is it? What if you added a "NOT NULL" column with no default value? Yes, your existing auto-initialized class will pick up the change, but your existing code will no longer be able to L one these objects. Or what if you're using MySQL and your newly added column is one of the types described above that requires manual tweaking in order to get the desired semantics. Will you always remember to make this change? Auto-initialization is not a panacea. Every time you make a change to your database schema, you must also revisit each affected L-derived class to at least consider whether or not the metadata needs to be corrected or updated. The trade-off may be well worth it, but it's still something to think about. There is, however, a hybrid solution that might be even better. Continue on to the next section to learn more. =head2 Code Generation As described in the L
, auto-initializing metadata at runtime by querying the database has many caveats. An alternate approach is to query the database for metadata just once, and then generate the equivalent Perl code which can be pasted directly into the class definition in place of the call to L. Like the auto-initialization process itself, perl code generation has a convenient wrapper method as well as separate methods for the individual parts. All of the perl code generation methods begin with "perl_", and they support some rudimentary code formatting options to help the code conform to you preferred style. Examples can be found with the documentation for each perl_* method. This hybrid approach to metadata population strikes a good balance between upfront effort and ongoing maintenance. Auto-generating the Perl code for the initial class definition saves a lot of tedious typing. From that point on, manually correcting and maintaining the definition is a small price to pay for the decreased start-up cost, the ability to use the class in the absence of a database connection, and the piece of mind that comes from knowing that your class is stable, and won't change behind your back in response to an "action at a distance" (i.e., a database schema update). =head1 CLASS METHODS =over 4 =item B Get or set a boolean value that indicates whether or not the L method will be called from within the L method. The default is true if the C environment variable (C<$ENV{'MOD_PERL'}>) is set to a true value, false otherwise. =item B Clears the L attribute of the metadata object for each L. =item B Given the column type string TYPE, return the name of the L-derived class used to store metadata and create the accessor method(s) for columns of that type. If a CLASS is passed, the column type TYPE is mapped to CLASS. In both cases, the TYPE argument is automatically converted to lowercase. =item B Get or set the hash that maps column type strings to the names of the L-derived classes used to store metadata and create accessor method(s) for columns of that type. This hash is class data. If you want to modify it, I suggest making your own subclass of L and then setting that as the L of your L subclass. If passed MAP (a list of type/class pairs or a reference to a hash of the same) then MAP replaces the current column type mapping. Returns a list of type/class pairs (in list context) or a reference to the hash of type/class mappings (in scalar context). The default mapping of type names to class names is: scalar => Rose::DB::Object::Metadata::Column::Scalar char => Rose::DB::Object::Metadata::Column::Character character => Rose::DB::Object::Metadata::Column::Character varchar => Rose::DB::Object::Metadata::Column::Varchar varchar2 => Rose::DB::Object::Metadata::Column::Varchar nvarchar => Rose::DB::Object::Metadata::Column::Varchar nvarchar2 => Rose::DB::Object::Metadata::Column::Varchar string => Rose::DB::Object::Metadata::Column::Varchar text => Rose::DB::Object::Metadata::Column::Text blob => Rose::DB::Object::Metadata::Column::Blob bytea => Rose::DB::Object::Metadata::Column::Pg::Bytea bits => Rose::DB::Object::Metadata::Column::Bitfield bitfield => Rose::DB::Object::Metadata::Column::Bitfield bool => Rose::DB::Object::Metadata::Column::Boolean boolean => Rose::DB::Object::Metadata::Column::Boolean int => Rose::DB::Object::Metadata::Column::Integer integer => Rose::DB::Object::Metadata::Column::Integer tinyint => Rose::DB::Object::Metadata::Column::Integer smallint => Rose::DB::Object::Metadata::Column::Integer mediumint => Rose::DB::Object::Metadata::Column::Integer bigint => Rose::DB::Object::Metadata::Column::BigInt serial => Rose::DB::Object::Metadata::Column::Serial bigserial => Rose::DB::Object::Metadata::Column::BigSerial enum => Rose::DB::Object::Metadata::Column::Enum num => Rose::DB::Object::Metadata::Column::Numeric numeric => Rose::DB::Object::Metadata::Column::Numeric decimal => Rose::DB::Object::Metadata::Column::Numeric float => Rose::DB::Object::Metadata::Column::Float float8 => Rose::DB::Object::Metadata::Column::DoublePrecision 'double precision' => Rose::DB::Object::Metadata::Column::DoublePrecision time => Rose::DB::Object::Metadata::Column::Time interval => Rose::DB::Object::Metadata::Column::Interval date => Rose::DB::Object::Metadata::Column::Date datetime => Rose::DB::Object::Metadata::Column::Datetime timestamp => Rose::DB::Object::Metadata::Column::Timestamp timestamptz => Rose::DB::Object::Metadata::Column::TimestampWithTimeZone 'timestamp with time zone' => Rose::DB::Object::Metadata::Column::TimestampWithTimeZone 'datetime year to fraction' => Rose::DB::Object::Metadata::Column::DatetimeYearToFraction 'datetime year to fraction(1)' => Rose::DB::Object::Metadata::Column::DatetimeYearToFraction1 'datetime year to fraction(2)' => Rose::DB::Object::Metadata::Column::DatetimeYearToFraction2 'datetime year to fraction(3)' => Rose::DB::Object::Metadata::Column::DatetimeYearToFraction3 'datetime year to fraction(4)' => Rose::DB::Object::Metadata::Column::DatetimeYearToFraction4 'datetime year to fraction(5)' => Rose::DB::Object::Metadata::Column::DatetimeYearToFraction5 'timestamp with time zone' => Rose::DB::Object::Metadata::Column::Timestamp 'timestamp without time zone' => Rose::DB::Object::Metadata::Column::Timestamp 'datetime year to second' => Rose::DB::Object::Metadata::Column::DatetimeYearToSecond 'datetime year to minute' => Rose::DB::Object::Metadata::Column::DatetimeYearToMinute 'datetime year to month' => Rose::DB::Object::Metadata::Column::DatetimeYearToMonth 'epoch' => Rose::DB::Object::Metadata::Column::Epoch 'epoch hires' => Rose::DB::Object::Metadata::Column::Epoch::HiRes array => Rose::DB::Object::Metadata::Column::Array set => Rose::DB::Object::Metadata::Column::Set chkpass => Rose::DB::Object::Metadata::Column::Pg::Chkpass =item B Returns the list (in list context) or reference to an array (in scalar context) of registered column type names. =item B Given the string NAME, return the name of the L-derived class L to that name. If a CLASS is passed, then NAME is mapped to CLASS. =item B Get or set the hash that maps names to L-derived class names. This hash is class data. If you want to modify it, I suggest making your own subclass of L and then setting that as the L of your L subclass. If passed MAP (a list of name/class pairs or a reference to a hash of the same) then MAP replaces the current mapping. Returns a list of name/class pairs (in list context) or a reference to the hash of name/class mappings (in scalar context). The default mapping of names to classes is: default => Rose::DB::Object::ConventionManager null => Rose::DB::Object::ConventionManager::Null =item B Get or set a boolean value that indicates whether or not the L-derived L will use L's L method by default (instead of the L method) when L, L, and L objects. The default value is true. =item B Get or set the default value of the L attribute. Defaults to undef. =item B Get or set the default name of the base class used by this metadata class when generating a L classes. The default value is C. See the C L to override this value for a specific metadata object. =item B Returns (or creates, if needed) the single L object associated with CLASS, where CLASS is the name of a L-derived class. =item B This class method should return a reference to a subroutine that maps column names to method names, or false if it does not want to do any custom mapping. The default implementation returns zero (0). If defined, the subroutine should take four arguments: the metadata object, the column name, the column method type, and the method name that would be used if the mapper subroutine did not exist. It should return a method name. =item B Call L on all L, passing PARAMS to each call. PARAMS are name/value pairs. Valid parameters are: =over 4 =item B A L-derived object used to determine which data source the cached metadata will be generated on behalf of. (Each data source has its own set of cached metadata.) This parameter is optional. If it is not passed, then the L-derived object returned by the L method for each L will be used instead. =back =item B Given the relationship type string TYPE, return the name of the L-derived class used to store metadata and create the accessor method(s) for relationships of that type. =item B Get or set the hash that maps relationship type strings to the names of the L-derived classes used to store metadata and create object methods fetch and/or manipulate objects from foreign tables. This hash is class data. If you want to modify it, I suggest making your own subclass of L and then setting that as the L of your L subclass. If passed MAP (a list of type/class pairs or a reference to a hash of the same) then MAP replaces the current relationship type mapping. Returns a list of type/class pairs (in list context) or a reference to the hash of type/class mappings (in scalar context). The default mapping of type names to class names is: 'one to one' => Rose::DB::Object::Metadata::Relationship::OneToOne 'one to many' => Rose::DB::Object::Metadata::Relationship::OneToMany 'many to one' => Rose::DB::Object::Metadata::Relationship::ManyToOne 'many to many' => Rose::DB::Object::Metadata::Relationship::ManyToMany =item B Return a list (in list context) or reference to an array (in scalar context) of the names of all L-derived classes registered under this metadata class's L. =item B Returns the string used to group L-derived class names in the class registry. The default is "Rose::DB::Object::Metadata". =back =head1 CONSTRUCTOR =over 4 =item B Returns (or creates, if needed) the single L associated with a particular L-derived class, modifying or initializing it according to PARAMS, where PARAMS are name/value pairs. Any object method is a valid parameter name, but PARAMS I include a value for the C parameter, since that's how L objects are mapped to their corresponding L-derived class. =back =head1 OBJECT METHODS =over 4 =item B This is an alias for the L method. =item B Add the columns specified by ARGS to the list of columns for the table. Returns the list of columns added in list context, or a reference to an array of columns added in scalar context. Columns can be specified in ARGS in several ways. If an argument is a subclass of L, it is added as-is. If an argument is a plain scalar, it is taken as the name of a scalar column. A column object of the class returned by the method call C<$obj-Ecolumn_type_class('scalar')> is constructed and then added. Otherwise, only name/value pairs are considered, where the name is taken as the column name and the value must be a reference to a hash. If the hash contains the key "primary_key" with a true value, then the column is marked as a L and the column name is added to the list of primary key columns by calling the L method with the column name as its argument. If the hash contains the key "alias", then the value of that key is used as the alias for the column. This is a shorthand equivalent to explicitly calling the L column method. If the hash contains the key "temp" and its value is true, then the column is actually added to the list of L. If the hash contains a key with the same name as a L (e.g., "on_set", "on_load", "inflate") then the value of that key must be a code reference or a reference to an array of code references, which will be L to the list of the column's L for the specified event type. If the hash contains the key "methods", then its value must be a reference to an array or a reference to a hash. The L of the column are then set to the values of the referenced array, or the keys of the referenced hash. The values of the referenced hash are used to set the L for their corresponding method types. If the hash contains the key "add_methods", then its value must be a reference to an array or a reference to a hash. The values of the referenced array or the keys of the referenced hash are added to the column's L. The values of the referenced hash are used to set the L for their corresponding method types. If the "methods" and "add_methods" keys are both set, a fatal error will occur. Then the L method is called with the value of the "type" hash key as its argument (or "scalar" if that key is missing), returning the name of a column class. Finally, a new column object of that class is constructed and is passed all the remaining pairs in the hash reference, along with the name and type of the column. That column object is then added to the list of columns. This is done until there are no more arguments to be processed, or until an argument does not conform to one of the required formats, in which case a fatal error occurs. Example: $meta->add_columns ( # Add a scalar column 'name', # which is roughly equivalent to: # # $class = $meta->column_type_class('scalar'); # $col = $class->new(name => 'name'); # (then add $col to the list of columns) # Add by name/hashref pair with explicit method types age => { type => 'int', default => 5, methods => [ 'get', 'set' ] }, # which is roughly equivalent to: # # $class = $meta->column_type_class('int'); # $col = $class->new(name => 'age', # type => 'int', # default => 5); # $col->auto_method_types('get', 'set'); # (then add $col to the list of columns) # Add by name/hashref pair with additional method type and name size => { type => 'int', add_methods => { 'set' => 'set_my_size' } }, # which is roughly equivalent to: # # $class = $meta->column_type_class('int'); # $col = $class->new(name => 'size', # type => 'int',); # $col->add_auto_method_types('set'); # $col->method_name(set => 'set_my_size'); # (then add $col to the list of columns) # Add a column object directly Rose::DB::Object::Metadata::Column::Date->new( name => 'start_date'), ); =item B This is an alias for the L method. =item B This method behaves like the L method, except that it adds to the list of L. See the documentation for the L method for more information. =item B Add foreign keys as specified by ARGS. Each foreign key must have a L that is unique among all other foreign keys in this L. Foreign keys can be specified in ARGS in several ways. If an argument is a L object (or subclass thereof), it is added as-is. Otherwise, only name/value pairs are considered, where the name is taken as the foreign key name and the value must be a reference to a hash. If the hash contains the key "methods", then its value must be a reference to an array or a reference to a hash. The L of the foreign key are then set to the values of the referenced array, or the keys of the referenced hash. The values of the referenced hash are used to set the L for their corresponding method types. If the hash contains the key "add_methods", then its value must be a reference to an array or a reference to a hash. The values of the referenced array or the keys of the referenced hash are added to the foreign key's L. The values of the referenced hash are used to set the L for their corresponding method types. If the "methods" and "add_methods" keys are both set, a fatal error will occur. A new L object is constructed and is passed all the remaining pairs in the hash reference, along with the name of the foreign key as the value of the "name" parameter. That foreign key object is then added to the list of foreign keys. This is done until there are no more arguments to be processed, or until an argument does not conform to one of the required formats, in which case a fatal error occurs. Example: $meta->add_foreign_keys ( # Add by name/hashref pair with explicit method type category => { class => 'Category', key_columns => { category_id => 'id' }, methods => [ 'get' ], }, # which is roughly equivalent to: # # $fk = Rose::DB::Object::Metadata::ForeignKey->new( # class => 'Category', # key_columns => { category_id => 'id' }, # name => 'category'); # $fk->auto_method_types('get'); # (then add $fk to the list of foreign keys) # Add by name/hashref pair with additional method type and name color => { class => 'Color', key_columns => { color_id => 'id' }, add_methods => { set => 'set_my_color' }, }, # which is roughly equivalent to: # # $fk = Rose::DB::Object::Metadata::ForeignKey->new( # class => 'Color', # key_columns => { color_id => 'id' }, # name => 'color'); # $fk->add_auto_method_types('set'); # $fk->method_name(set => 'set_my_color'); # (then add $fk to the list of foreign keys) # Add a foreign key object directly Rose::DB::Object::Metadata::ForeignKey->new(...), ); For each foreign key added, a corresponding relationship with the same name is added if it does not already exist. The relationship type is determined by the value of the foreign key object's L attribute. The default is "many to one". The class of the relationship is chosen by calling L with the relationship type as an argument. =item B This method is an alias for L. =item B Add COLUMNS to the list of columns that make up the primary key. COLUMNS can be a list or reference to an array of column names. =item B This is an alias for the L method. =item B Add relationships as specified by ARGS. Each relationship must have a L that is unique among all other relationships in this L. Relationships can be specified in ARGS in several ways. If an argument is a subclass of L, it is added as-is. Otherwise, only name/value pairs are considered, where the name is taken as the relationship name and the value must be a reference to a hash. If the hash contains the key "methods", then its value must be a reference to an array or a reference to a hash. The L of the relationship are then set to the values of the referenced array, or the keys of the referenced hash. The values of the referenced hash are used to set the L for their corresponding method types. If the hash contains the key "add_methods", then its value must be a reference to an array or a reference to a hash. The values of the referenced array or the keys of the referenced hash are added to the relationship's L. The values of the referenced hash are used to set the L for their corresponding method types. If the "methods" and "add_methods" keys are both set, a fatal error will occur. Then the L method is called with the value of the C hash key as its argument, returning the name of a relationship class. Finally, a new relationship object of that class is constructed and is passed all the remaining pairs in the hash reference, along with the name and type of the relationship. That relationship object is then added to the list of relationships. This is done until there are no more arguments to be processed, or until an argument does not conform to one of the required formats, in which case a fatal error occurs. Example: $meta->add_relationships ( # Add by name/hashref pair with explicit method type category => { type => 'many to one', class => 'Category', column_map => { category_id => 'id' }, methods => [ 'get' ], }, # which is roughly equivalent to: # # $class = $meta->relationship_type_class('many to one'); # $rel = $class->new(class => 'Category', # column_map => { category_id => 'id' }, # name => 'category'); # $rel->auto_method_types('get'); # (then add $rel to the list of relationships) # Add by name/hashref pair with additional method type and name color => { type => 'many to one', class => 'Color', column_map => { color_id => 'id' }, add_methods => { set => 'set_my_color' }, }, # which is roughly equivalent to: # # $class = $meta->relationship_type_class('many to one'); # $rel = $class->new(class => 'Color', # column_map => { color_id => 'id' }, # name => 'color'); # $rel->add_auto_method_types('set'); # $fk->method_name(set => 'set_my_color'); # (rel add $fk to the list of foreign keys) # Add a relationship object directly Rose::DB::Object::Metadata::Relationship::OneToOne->new(...), ); =item B This method is an alias for L. =item B Add new unique keys specified by KEYS. Unique keys can be specified in KEYS in two ways. If an argument is a L object (or subclass thereof), then its L is set to the metadata object itself, and it is added. Otherwise, an argument must be a single column name or a reference to an array of column names that make up a unique key. A new L is created, with its L set to the metadata object itself, and then the unique key object is added to this list of unique keys for this L. =item B Set the L for the column named NAME to ALIAS. It is sometimes necessary to use an alias for a column because the column name conflicts with an existing L method name. For example, imagine a column named "save". The L API already defines a method named L, so obviously that name can't be used for the accessor method for the "save" column. To solve this, make an alias: $meta->alias_column(save => 'save_flag'); See the L documentation or call the L method to determine if a method name is reserved. =item B Get or set the boolean flag that indicates whether or not the associated L-derived class should try to inline column values that L does not handle correctly when they are bound to placeholders using L. The default value is false. Enabling this flag reduces the performance of the L and L operations on the L-derived object. But it is sometimes necessary to enable the flag because some L drivers do not (or cannot) always do the right thing when binding values to placeholders in SQL statements. For example, consider the following SQL for the Informix database: CREATE TABLE test (d DATETIME YEAR TO SECOND); INSERT INTO test (d) VALUES (CURRENT); This is valid Informix SQL and will insert a row with the current date and time into the "test" table. Now consider the following attempt to do the same thing using L placeholders (assume the table was already created as per the CREATE TABLE statement above): $sth = $dbh->prepare('INSERT INTO test (d) VALUES (?)'); $sth->execute('CURRENT'); # Error! What you'll end up with is an error like this: DBD::Informix::st execute failed: SQL: -1262: Non-numeric character in datetime or interval. In other words, L has tried to quote the string "CURRENT", which has special meaning to Informix only when it is not quoted. In order to make this work, the value "CURRENT" must be "inlined" rather than bound to a placeholder when it is the value of a "DATETIME YEAR TO SECOND" column in an Informix database. =item B Get or set a flag that indicates whether or not classes related to this L through a L or other L will be automatically loaded when this L is Ld. The default value is true. =item B This method is only applicable if this metadata object is associated with a L-derived class. It simply calls the class method of the same name that belongs to the L-derived L associated with this metadata object. =item B Get or set the database catalog for this L. This setting will B any L in the L object. Use this method only if you know that the L will always point to a specific catalog, regardless of what the L-derived database handle object specifies. =item B Get or set the L-derived class associated with this metadata object. This is the class where the accessor methods for each column will be created (by L). =item B Returns the name of the L-derived class associated with the C, C, and C
specified by the name/value paris in PARAMS. Catalog and/or schema maybe omitted if unknown or inapplicable, and the "best" match will be returned. Returns undef if there is no class name registered under the specified PARAMS. Note: This method may also be called as a class method, but may require explicit C and/or C arguments when dealing with databases that support these concepts I have default implicit values for them. =item B This method is only applicable if this metadata object is associated with a L-derived class. It simply calls the class method of the same name that belongs to the L-derived L associated with this metadata object. =item B Get or set the column named NAME. If just NAME is passed, the L-derived column object for the column of that name is returned. If no such column exists, undef is returned. If both NAME and COLUMN are passed, then COLUMN must be a L-derived object. COLUMN has its L set to NAME, and is then stored as the column metadata object for NAME, replacing any existing column. If both NAME and HASHREF are passed, then the combination of NAME and HASHREF must form a name/value pair suitable for passing to the L method. The new column specified by NAME and HASHREF replaces any existing column. =item B Get or set the full list of columns. If ARGS are passed, the column list is cleared and then ARGS are passed to the L method. Returns a list of column objects in list context, or a reference to an array of column objects in scalar context. =item B Returns the name of the "get" method for the column named NAME. This is just a shortcut for C<$meta-Ecolumn(NAME)-Eaccessor_method_name>. =item B Returns a list (in list context) or a reference to the array (in scalar context) of the names of the "set" methods for all the columns, in the order that the columns are returned by L. =item B Get or set the hash that maps column names to their aliases. If passed MAP (a list of name/value pairs or a reference to a hash) then MAP replaces the current alias mapping. Returns a reference to the hash that maps column names to their aliases. Note that modifying this map has no effect if L, L, or L has already been called for the current L. =item B Returns the name of the "set" method for the column named NAME. This is just a shortcut for C<$meta-Ecolumn(NAME)-Emutator_method_name>. =item B Returns a list (in list context) or a reference to the array (in scalar context) of the names of the "set" methods for all the columns, in the order that the columns are returned by L. =item B Returns a list (in list context) or a reference to an array (in scalar context) of column names. =item B Get or set the code reference to the subroutine used to map column names to method names. If undefined, then the L class method is called in order to initialize it. If still undefined or false, then the "default" method name is used. If defined, the subroutine should take four arguments: the metadata object, the column name, the column method type, and the method name that would be used if the mapper subroutine did not exist. It should return a method name. =item B Returns the name of the "get_set" method for the column named NAME. This is just a shortcut for C<$meta-Ecolumn(NAME)-Erw_method_name>. =item B Returns a list (in list context) or a reference to the array (in scalar context) of the names of the "get_set" methods for all the columns, in the order that the columns are returned by L. =item B Get or set a boolean value that influences the default value of the L attribute for each L in this L. See the documentation for L's L attribute for more information. Defaults to the value returned by the L class method. =item B Get or set the convention manager for this L. Defaults to the return value of the L method. If undef is passed, then a L object is stored instead. If a L-derived object is passed, its L attribute set to this metadata object and then it is used as the convention manager for this L. If a L-derived class name is passed, a new object of that class is created with its L attribute set to this metadata object. Then it is used as the convention manager for this L. If a convention manager name is passed, then the corresponding class is looked up in the L, a new object of that class is constructed, its L attribute set to this metadata object, and it is used as the convention manager for this L. If there is no class mapped to NAME, a fatal error will occur. See the L documentation for more information on convention managers. =item B Returns the L-derived object associated with this metadata object's L. A fatal error will occur if L is undefined or if the L object could not be created. =item B Get or set a boolean value that indicates whether or not the L associated with this metadata object will L related objects when the parent object is L. See the documentation for L's L method for details. The default value is false. =item B Get or set a boolean value that indicates whether or not the L associated with this metadata object will L speculatively by default. See the documentation for L's L method for details. The default value is false. =item B Get or set a boolean value that indicates whether or not the L associated with this metadata object will L only an object's modified columns by default (instead of updating all columns). See the documentation for L's L method for details. The default value is false. =item B Delete the column named NAME. =item B Delete all of the L. =item B Delete the type/class L entry for the column type TYPE. =item B Delete the name/class L entry for the convention manager class mapped to NAME. =item B Delete the L named NAME. =item B Delete all of the L. =item B Delete the relationship named NAME. =item B Delete all of the relationships. =item B Delete the type/class mapping entry for the relationship type TYPE. =item B Delete all of the unique key definitions. =item B Get or set the error mode of the L that fronts the table described by this L object. If the error mode is false, then it defaults to the return value of the C method, which is "fatal" by default. The error mode determines what happens when a L method encounters an error. The "return" error mode causes the methods to behave as described in the L documentation. All other error modes cause an action to be performed before (possibly) returning as per the documentation (depending on whether or not the "action" is some variation on "throw an exception.") Valid values of MODE are: =over 4 =item carp Call L with the value of the object L as an argument. =item cluck Call L with the value of the object L as an argument. =item confess Call L with the value of the object L as an argument. =item croak Call L with the value of the object L as an argument. =item fatal An alias for the "croak" mode. =item return Return a value that indicates that an error has occurred, as described in the L for each method. =back In all cases, the object's L attribute will also contain the error message. =item B Returns the first column, determined by the order that columns were L, or undef if there are no columns. =item B Get or set the foreign key named NAME. NAME should be the name of the thing being referenced by the foreign key, I the name of any of the columns that make up the foreign key. If called with just a NAME argument, the foreign key stored under that name is returned. Undef is returned if there is no such foreign key. If both NAME and FOREIGNKEY are passed, then FOREIGNKEY must be a L-derived object. FOREIGNKEY has its L set to NAME, and is then stored, replacing any existing foreign key with the same name. If both NAME and HASHREF are passed, then the combination of NAME and HASHREF must form a name/value pair suitable for passing to the L method. The new foreign key specified by NAME and HASHREF replaces any existing foreign key with the same name. =item B Get or set the full list of foreign keys. If ARGS are passed, the foreign key list is cleared and then ARGS are passed to the L method. Returns a list of foreign key objects in list context, or a reference to an array of foreign key objects in scalar context. =item B This method is the same as L except that it only returns the generated value for the first primary key column, rather than the entire list of values. Use this method only when there is a single primary key column (or not at all). =item B Given the L-derived object DB, generate and return a list of new primary key column values for the table described by this metadata object. If a L is defined, it will be called (passed this metadata object and the DB) and its value returned. If no L is defined, new primary key values will be generated, if possible, using the native facilities of the current database. Note that this may not be possible for databases that auto-generate such values only after an insertion. In that case, undef will be returned. =item B Get or set a boolean value that indicates whether or not the L method will create L for unique indexes that have predicates. The default value is false. This feature is currently only supported for PostgreSQL. Here's an example of a unique index that has a predicate: CREATE UNIQUE INDEX my_idx ON mytable (mycolumn) WHERE mycolumn > 123; The predicate in this case is C 123>. Predicated unique indexes differ semantically from unpredicated unique indexes in that predicates generally cause the index to only apply to part of a table. L expects L to uniquely identify a row within a table. Predicated indexes that fail to do so due to their predicates should therefore not have L objects created for them, thus the false default for this attribute. =item B Returns the default L-derived object used as the L for this L. This object will be of the class returned by L. Override this method in your L subclass, or L the "default" convention manager class, in order to use a different convention manager class. See the L section of the L documentation for an example of the subclassing approach. =item B Initialize the L-derived class associated with this metadata object by creating accessor methods for each column and foreign key. The L name and the L must be defined or a fatal error will occur. If any column name in the primary key or any of the unique keys does not exist in the list of L, then that primary or unique key is deleted. (As per the above, this will trigger a fatal error if any column in the primary key is not in the column list.) ARGS, if any, are passed to the call to L that actually creates the methods. If L is true, then the L method will be called at the end of the initialization process. =item B Get or set a boolean value that indicates whether or not this L was Ld. A successful call to the L method will automatically set this flag to true. =item B This method creates a L-derived class to manage objects of this L. To do so, it simply calls L, passing all arguments, and then Luates the result. See the L documentation for more information. =item B Create object methods in L for each L, L, and L. This is done by calling L, L, L, and L, in that order. ARGS are name/value pairs which are passed on to the other C calls. They are all optional. Valid ARGS are: =over 4 =item * C If set to a true value, a method will not be created if there is already an existing method with the same named. =item * C If set to a true value, override any existing method with the same name. =back In the absence of one of these parameters, any method name that conflicts with an existing method name will cause a fatal error. =item B Create accessor/mutator methods in L for each L. ARGS are name/value pairs, and are all optional. Valid ARGS are: =over 4 =item * C If set to a true value, a method will not be created if there is already an existing method with the same named. =item * C If set to a true value, override any existing method with the same name. =back For each L in each column, the method name is determined by passing the column name and the method type to L. If the resulting method name is reserved (according to L, a fatal error will occur. The object methods for each column are created by calling the column object's L method. =item B Create object methods in L for each L. ARGS are name/value pairs, and are all optional. Valid ARGS are: =over 4 =item * C If set to a true value, a method will not be created if there is already an existing method with the same named. =item * C If set to a true value, override any existing method with the same name. =back For each L in each foreign key, the method name is determined by passing the method type to the L method of the foreign key object, or the L method if the L call returns a false value. If the method name is reserved (according to L), a fatal error will occur. The object methods for each foreign key are created by calling the foreign key object's L method. Foreign keys and relationships with the L "one to one" or "many to one" both encapsulate essentially the same information. They are kept in sync when this method is called by setting the L attribute of each "L" or "L" relationship object to be the corresponding foreign key object. =item B This method behaves like the L method, except that it works with L. See the documentation for the L method for more information on non-persistent columns. =item B Create object methods in L for each L. ARGS are name/value pairs, and are all optional. Valid ARGS are: =over 4 =item * C If set to a true value, a method will not be created if there is already an existing method with the same named. =item * C If set to a true value, override any existing method with the same name. =back For each L in each relationship, the method name is determined by passing the method type to the L method of the relationship object, or the L method if the L call returns a false value. If the method name is reserved (according to L), a fatal error will occur. The object methods for each relationship are created by calling the relationship object's L method. Foreign keys and relationships with the L "one to one" or "many to one" both encapsulate essentially the same information. They are kept in sync when this method is called by setting the L attribute of each "L" or "L" relationship object to be the corresponding foreign key object. If a relationship corresponds exactly to a foreign key, and that foreign key already made an object method, then the relationship is not asked to make its own method. =item B Get or set the default name of the base class used by this specific metadata object when generating a L class, using either the L or L methods. The default value is determined by the C L. =item B Returns the name of the column manipulated by the method named METHOD. =item B Looks up the column named NAME and calls L with the column and TYPE as argument. If no such column exists, a fatal error will occur. =item B Given a L-derived column object and a column L name, return the corresponding method name that should be used for it. Several entities are given an opportunity to determine the name. They are consulted in the following order. =over 4 =item 1. If a custom-defined L exists, then it is used to generate the method name and this name is returned. =item 2. If a method name has been L, for this type in the column object itself, then this name is returned. =item 3. If the L's L method returns a defined value, then this name is returned. =item 4. Otherwise, the default naming rules as defined in the column class itself are used. =back =item B Given the method name NAME and the class name CLASS, returns true if the method name is reserved (i.e., is used by the CLASS API), false otherwise. =item B This method behaves like the L method, except that it works with L. See the documentation for the L method for more information on non-persistent columns. =item B Get or set the full list of non-persistent columns. If ARGS are passed, the non-persistent column list is cleared and then ARGS are passed to the L method. Returns a list of non-persistent column objects in list context, or a reference to an array of non-persistent column objects in scalar context. Non-persistent columns allow the creation of object attributes and associated accessor/mutator methods exactly like those associated with L, but I ever sending any of these attributes to (or pulling any these attributes from) the database. Non-persistent columns are tracked entirely separately from L. L, L, and listing non-persistent columns has no affect on the list of normal (i.e., "persistent") L. You cannot query the database (e.g., using L) and filter on a non-persistent column; non-persistent columns do not exist in the database. This feature exists solely to leverage the method creation abilities of the various column classes. =item B Returns the name of the "get" method for the L column named NAME. This is just a shortcut for C<$meta-Enonpersistent_column(NAME)-Eaccessor_method_name>. =item B Returns a list (in list context) or a reference to the array (in scalar context) of the names of the "set" methods for all the L columns, in the order that the columns are returned by L. =item B Returns the name of the "set" method for the L column named NAME. This is just a shortcut for C<$meta-Enonpersistent_column(NAME)-Emutator_method_name>. =item B Returns a list (in list context) or a reference to the array (in scalar context) of the names of the "set" methods for all the L, in the order that the columns are returned by L. =item B Returns a list (in list context) or a reference to an array (in scalar context) of L column names. =item B This is an alias for the L method. =item B Get or set a reference to a subroutine or a reference to an array of code references that will be called just after the L method runs. Each referenced subroutine will be passed the metadata object itself and any arguments passed to the call to L. =item B Get or set a reference to a subroutine or a reference to an array of code references that will be called just before the L method runs. Each referenced subroutine will be passed the metadata object itself and any arguments passed to the call to L. =item B Get or set the L object that stores the list of column names that make up the primary key for this table. =item B Get or set the list of columns that make up the primary key. COLUMNS should be a list of column names or L-derived objects. Returns all of the columns that make up the primary key. Each column is a L-derived column object if a L object with the same name exists, or just the column name otherwise. In scalar context, a reference to an array of columns is returned. In list context, a list is returned. This method is just a shortcut for the code: $meta->primary_key->columns(...); See the L method and the L class for more information. =item B Get or set the names of the columns that make up the table's primary key. NAMES should be a list or reference to an array of column names. Returns the list of column names (in list context) or a reference to the array of column names (in scalar context). This method is just a shortcut for the code: $meta->primary_key->column_names(...); See the L method and the L class for more information. =item B Get or set the subroutine used to generate new primary key values for the primary key columns of this table. The subroutine will be passed two arguments: the current metadata object and the L-derived object that points to the current database. The subroutine is expected to return a list of values, one for each primary key column. The values must be in the same order as the corresponding columns returned by L. (i.e., the first value belongs to the first column returned by L, the second value belongs to the second column, and so on.) =item B Get or set the list of database sequence names used to populate the primary key columns. The sequence names must be in the same order as the L. NAMES may be a list or reference to an array of sequence names. Returns a list (in list context) or reference to the array (in scalar context) of sequence names. If you do not set this value, it will be derived for you based on the name of the primary key columns. In the common case, you do not need to be concerned about this method. If you are using the built-in SERIAL or AUTO_INCREMENT types in your database for your primary key columns, everything should just work. =item B By default, secondary metadata derived from the attributes of this object is created and cached on demand. Call this method to pre-cache this metadata all at once. This method is useful when running in an environment like L where it's advantageous to load as much data as possible on start-up. PARAMS are name/value pairs. Valid parameters are: =over 4 =item B A L-derived object used to determine which data source the cached metadata will be generated on behalf of. (Each data source has its own set of cached metadata.) This parameter is optional. If it is not passed, then the L-derived object returned by the L method for this L will be used instead. =back =item B Get or set the relationship named NAME. If just NAME is passed, the L-derived relationship object for that NAME is returned. If no such relationship exists, undef is returned. If both NAME and RELATIONSHIP are passed, then RELATIONSHIP must be a L-derived object. RELATIONSHIP has its L set to NAME, and is then stored as the relationship metadata object for NAME, replacing any existing relationship. If both NAME and HASHREF are passed, then the combination of NAME and HASHREF must form a name/value pair suitable for passing to the L method. The new relationship specified by NAME and HASHREF replaces any existing relationship. =item B Get or set the full list of relationships. If ARGS are passed, the relationship list is cleared and then ARGS are passed to the L method. Returns a list of relationship objects in list context, or a reference to an array of relationship objects in scalar context. =item B Replace the column named NAME with a newly constructed column. This method is equivalent to L any existing column named NAME and then L a new one. In other words, this: $meta->replace_column($name => $value); is equivalent to this: $meta->delete_column($name); $meta->add_column($name => $value); The value of the new column may be a L-derived object or a reference to a hash suitable for passing to the L method. =item B Get or set the database schema for this L. This setting will B any L in the L object. Use this method only if you know that the L will always point to a specific schema, regardless of what the L-derived database handle object specifies. =item B Set up all the metadata for this L in a single method call. This method is a convenient shortcut. It does its work by delegating to other methods. The L method does nothing if the metadata object is already initialized (according to the L method). PARAMS are method/arguments pairs. In general, the following transformations apply. Given a method/arrayref pair: METHOD => [ ARG1, ARG2 ] The arguments will be removed from their array reference and passed to METHOD like this: $meta->METHOD(ARG1, ARG2); Given a method/value pair: METHOD => ARG The argument will be passed to METHOD as-is: $meta->METHOD(ARG); There are two exceptions to these transformation rules. If METHOD is "L" or "L" and the argument is a reference to an array containing only non-reference values, then the array reference itself is passed to the method. For example, this pair: unique_key => [ 'name', 'status' ] will result in this method call: $meta->unique_key([ 'name', 'status' ]); (Note that these method names are I. This exception does I apply to the I variants, "L" and "L".) If METHOD is "helpers", then the argument is dereferenced (if it's an array reference) and passed on to L. That is, this: helpers => [ 'load_or_save', { load_or_insert => 'find_or_create' } ], Is equivalent to having this in your L: use Rose::DB::Object::Helpers 'load_or_save', { load_or_insert => 'find_or_create' }; Method names may appear more than once in PARAMS. The methods are called in the order that they appear in PARAMS, with the exception of the L (or L) method, which is always called last. If "initialize" is not one of the method names, then it will be called automatically (with no arguments) at the end. If you do not want to pass any arguments to the L method, standard practice is to omit it. If "auto_initialize" is one of the method names, then the L method will be called instead of the L method. This is useful if you want to manually set up a few pieces of metadata, but want the auto-initialization system to set up the rest. The name "auto" is considered equivalent to "auto_initialize", but any arguments are ignored unless they are encapsulated in a reference to an array. For example, these are equivalent: $meta->setup( table => 'mytable', # Call auto_initialize() with no arguments auto_initialize => [], ); # This is another way of writing the same thing as the above $meta->setup( table => 'mytable', # The value "1" is ignored because it's not an arrayref, # so auto_initialize() will be called with no arguments. auto => 1, ); Finally, here's a full example of a L method call followed by the equivalent "long-hand" implementation. $meta->setup ( table => 'colors', columns => [ code => { type => 'character', length => 3, not_null => 1 }, name => { type => 'varchar', length => 255 }, ], primary_key_columns => [ 'code' ], unique_key => [ 'name' ], ); The L method call above is equivalent to the following code: unless($meta->is_initialized) { $meta->table('colors'); $meta->columns( [ code => { type => 'character', length => 3, not_null => 1 }, name => { type => 'varchar', length => 255 }, ]); $meta->primary_key_columns('code'); $meta->unique_key([ 'name' ]), $meta->initialize; } =item B Get or set a boolean value that indicates whether or not to prefix the columns with the table name in the SQL used to L an object. The default value is false. For example, here is some SQL that might be used to L an object, as generated with L set to false: SELECT id, name FROM dogs WHERE id = 5; Now here's how it would look with L set to true: SELECT dogs.id, dogs.name FROM dogs WHERE dogs.id = 5; =item B
Get or set the name of the database table. The table name should not include any sort of prefix to indicate the L or L. =item B This method is an alias for L. =item B Get or set the list of unique keys for this table. If KEYS is passed, any existing keys will be deleted and KEYS will be passed to the L method. Returns the list (in list context) or reference to an array (in scalar context) of L objects. =item B Return the unique key L NAME, or undef if no such key exists. =item B Returns a list (in list context) or a reference to an array (in scalar context) or references to arrays of the column names that make up each unique key. That is: # Example of a scalar context return value [ [ 'id', 'name' ], [ 'code' ] ] # Example of a list context return value ([ 'id', 'name' ], [ 'code' ]) =back =head1 AUTO-INITIALIZATION METHODS These methods are associated with the L process. Calling any of them will cause the auto-initialization code to be loaded, which costs memory. This should be considered an implementation detail for now. Regardless of the implementation details, you should still avoid calling any of these methods unless you plan to do some auto-initialization. No matter how generic they may seem (e.g., L), rest assured that none of these methods are remotely useful I you are doing auto-initialization. =head2 CLASS METHODS =over 4 =item B Get or set the default brace style used in the Perl code generated by the perl_* object methods. STYLE must be either "k&r" or "bsd". The default value is "k&r". =item B Get or set the default integer number of spaces used for each level of indenting in the Perl code generated by the perl_* object methods. The default value is 4. =item B Get or set the default style of the unique key initialization used in the Perl code generated by the L method. STYLE must be "array" or "object". The default value is "array". See the L method for examples of the two styles. =back =head2 OBJECT METHODS =over 4 =item B Auto-generate L-derived objects for each column in the table. Note that this method does not modify the metadata object's list of L. It simply returns a list of column objects. Calling this method in void context will cause a fatal error. Returns a list of column objects (in list context) or a reference to a hash of column objects, keyed by column name (in scalar context). The hash reference return value is intended to allow easy modification of the auto-generated column objects. Example: $columns = $meta->auto_generate_columns; # hash ref return value # Make some changes $columns->{'name'}->length(10); # set different length $columns->{'age'}->default(5); # set different default ... # Finally, set the column list $meta->columns(values %$columns); If you do not want to modify the auto-generated columns, you should use the L method instead. A fatal error will occur unless at least one column was auto-generated. =item B Auto-generate L objects for each foreign key in the table. Note that this method does not modify the metadata object's list of L. It simply returns a list of foreign key objects. Calling this method in void context will cause a fatal error. A warning will be issued if a foreign key could not be generated because no L-derived class was found for the foreign table. PARAMS are optional name/value pairs. If a C parameter is passed with a true value, then the warning described above will not be issued. Returns a list of foreign key objects (in list context) or a reference to an array of foreign key objects (in scalar context). If you do not want to inspect or modify the auto-generated foreign keys, but just want them to populate the metadata object's L list, you should use the L method instead. B This method works with MySQL only when using the InnoDB storage type. =item B Auto-generate L objects for each unique key in the table. Note that this method does not modify the metadata object's list of L. It simply returns a list of unique key objects. Calling this method in void context will cause a fatal error. Returns a list of unique key objects (in list context) or a reference to an array of unique key objects (in scalar context). If you do not want to inspect or modify the auto-generated unique keys, but just want them to populate the metadata object's L list, you should use the L method instead. =item B Returns a list (in list context) or a reference to an array (in scalar context) of the names of the columns that make up the primary key for this table. Note that this method does not modify the metadata object's L. It simply returns a list of column names. Calling this method in void context will cause a fatal error. This method is rarely called explicitly. Usually, you will use the L method instead. A fatal error will occur unless at least one column name can be retrieved. (This method uses the word "retrieve" instead of "generate" like its sibling methods above because it does not generate objects; it simply returns column names.) =item B Auto-initialize the entire metadata object. This is a wrapper for the individual "auto_init_*" methods, and is roughly equivalent to this: $meta->auto_init_columns(...); $meta->auto_init_primary_key_columns; $meta->auto_init_unique_keys(...); $meta->auto_init_foreign_keys(...); $meta->auto_init_relationships(...); $meta->initialize; PARAMS are optional name/value pairs. When applicable, these parameters are passed on to each of the "auto_init_*" methods. Valid parameters are: =over 4 =item B By default, if a class is a L (according to the L method of the L), then relationships directly between that class and the current L will not be created. Set this parameter to true to allow such relationships to be created. B If some classes that are not actually map classes are being skipped, you should not use this parameter to force them to be included. It's more appropriate to make your own custom L subclass and then override the L method to make the correct determination. =item B If true, then the auto-generated columns, unique keys, foreign keys, and relationships entirely replace any existing columns, unique keys, foreign keys, and relationships, respectively. =item B If true, then any database connections retained by the metadata objects belonging to the various L-derived classes participating in the auto-initialization process will remain connected until an explicit call to the L class method. =item B A boolean value indicating whether or not foreign key metadata will be auto-initialized. Defaults to true. =item B A boolean value or a reference to an array of relationship L names. If set to a simple boolean value, then the all types of relationships will be considered for auto-initialization. If set to a list of relationship type names, then only relationships of those types will be considered. Defaults to true. =item B A boolean value indicating whether or not unique key metadata will be auto-initialized. Defaults to true. =back During initialization, if one of the columns has a method name that clashes with a L, then the L will be called to remedy the situation by aliasing the column. If the name still conflicts, then a fatal error will occur. A fatal error will occur if auto-initialization fails. =item B Auto-generate L objects for this table, then populate the list of L. PARAMS are optional name/value pairs. If a C parameter is passed with a true value, then the auto-generated columns replace any existing columns. Otherwise, any existing columns are left as-is. =item B Auto-generate L objects for this table, then populate the list of L. PARAMS are optional name/value pairs. If a C parameter is passed with a true value, then the auto-generated foreign keys replace any existing foreign keys. Otherwise, any existing foreign keys are left as-is. B This method works with MySQL only when using the InnoDB storage type. =item B Auto-retrieve the names of the columns that make up the primary key for this table, then populate the list of L. A fatal error will occur unless at least one primary key column name could be retrieved. =item B Auto-populate the list of L for this L. PARAMS are optional name/value pairs. =over 4 =item B By default, if a class is a L (according to the L method of the L), then relationships directly between that class and the current L will not be created. Set this parameter to true to allow such relationships to be created. B If some classes that are not actually map classes are being skipped, you should not use this parameter to force them to be included. It's more appropriate to make your own custom L subclass and then override the L method to make the correct determination. =item B If true, then the auto-generated relationships replace any existing relationships. Otherwise, any existing relationships are left as-is. =item B A reference to an array of relationship L names. Only relationships of these types will be created. If omitted, relationships of L will be created. If passed a reference to an empty array, no relationships will be created. =item B This is an alias for the C parameter. =item B This is the same as the C parameter except that it also accepts a boolean value. If true, then relationships of L will be created. If false, then none will be created. =back Assume that this L is called C and any hypothetical foreign class is called C. Relationships are auto-generated according to the following rules. =over 4 =item * A L relationship is created between C and C if C has a foreign key that points to C. This is not done, however, if C has a L relationship pointing to C that references the same columns as the foreign key in C that points to C, or if C is a map class (according to the L's L method). The relationship name is generated by the L's L method. =item * A L relationship is created between C and C if there exists a L (according to the convention manager's L method) with exactly two foreign keys, one pointing to L and on pointing to C. The relationship name is generated by creating a L version of the name of the foreign key in the map class that points to C. =back In all cases, if there is an existing, semantically identical relationship, then a new relationship is not auto-generated. Similarly, any existing methods with the same names are not overridden by methods associated with auto-generated relationships. =item B Auto-generate L objects for this table, then populate the list of L. PARAMS are name/value pairs. If a C parameter is passed with a true value, then the auto-generated unique keys replace any existing unique keys. Otherwise, any existing unique keys are left as-is. =item B Get or set the code reference to the subroutine used to alias columns have, or would generate, one or more method names that clash with L. The subroutine should take two arguments: the metadata object and the column name. The C<$_> variable will also be set to the column name at the time of the call. The subroutine should return an L for the column. The default column alias generator simply appends the string "_col" to the end of the column name and returns that as the alias. =item B Get or set the code reference to the subroutine used to generate L names. B This code will only be called if the L's L method fails to (or declines to) produce a defined foreign key name. The subroutine should take two arguments: a metadata object and a L object. It should return a name for the foreign key. Each foreign key must have a name that is unique within the class. By default, this name will also be the name of the method generated to access the object referred to by the foreign key, so it must be unique among method names in the class as well. The default foreign key name generator uses the following algorithm: If the foreign key has only one column, and if the name of that column ends with an underscore and the name of the referenced column, then that part of the column name is removed and the remaining string is used as the foreign key name. For example, given the following tables: CREATE TABLE categories ( id SERIAL PRIMARY KEY, ... ); CREATE TABLE products ( category_id INT REFERENCES categories (id), ... ); The foreign key name would be "category", which is the name of the referring column ("category_id") with an underscore and the name of the referenced column ("_id") removed from the end of it. If the foreign key has only one column, but it does not meet the criteria described above, then "_object" is appended to the name of the referring column and the resulting string is used as the foreign key name. If the foreign key has more than one column, then the foreign key name is generated by replacing double colons and case-transitions in the referenced class name with underscores, and then converting to lowercase. For example, if the referenced table is fronted by the class My::TableOfStuff, then the generated foreign key name would be "my_table_of_stuff". In all of the scenarios above, if the generated foreign key name is still not unique within the class, then a number is appended to the end of the name. That number is incremented until the name is unique. In practice, rather than setting a custom foreign key name generator, it's usually easier to simply set the foreign key name(s) manually after auto-initializing the foreign keys (but I calling L or L, of course). =item B Auto-initialize the columns, primary key, foreign keys, and unique keys, then return the Perl source code for a complete L-derived class definition. PARAMS are optional name/value pairs that may include the following: =over 4 =item B The brace style to use in the generated Perl code. STYLE must be either "k&r" or "bsd". The default value is determined by the return value of the L class method. =item B The integer number of spaces to use for each level of indenting in the generated Perl code. The default value is determined by the return value of the L class method. =item B The list of base classes to use in the generated class definition. CLASSES should be a single class name, or a reference to an array of class names. The default base class is L. =item B If true, then the generated class definition will include a call to the L method. Otherwise, the generated code will contain individual methods calls. The default value for this parameter is B; the L method is the recommended way to initialize a class. =back This method is simply a wrapper (with some glue) for the following methods: L, L, L, L, and L. The "braces" and "indent" parameters are passed on to these other methods. Here's a complete example, which also serves as an example of the individual "perl_*" methods that this method wraps. First, the table definitions. CREATE TABLE topics ( id SERIAL PRIMARY KEY, name VARCHAR(32) ); CREATE TABLE codes ( k1 INT NOT NULL, k2 INT NOT NULL, k3 INT NOT NULL, name VARCHAR(32), PRIMARY KEY(k1, k2, k3) ); CREATE TABLE products ( id SERIAL PRIMARY KEY, name VARCHAR(32) NOT NULL, flag BOOLEAN NOT NULL DEFAULT 't', status VARCHAR(32) DEFAULT 'active', topic_id INT REFERENCES topics (id), fk1 INT, fk2 INT, fk3 INT, last_modified TIMESTAMP, date_created TIMESTAMP, FOREIGN KEY (fk1, fk2, fk3) REFERENCES codes (k1, k2, k3) ); CREATE TABLE prices ( id SERIAL PRIMARY KEY, product_id INT REFERENCES products (id), price DECIMAL(10,2) NOT NULL DEFAULT 0.00, region CHAR(2) NOT NULL DEFAULT 'US' ); First we'll auto-initialize the classes. package Code; use base qw(Rose::DB::Object); __PACKAGE__->meta->auto_initialize; package Category; use base qw(Rose::DB::Object); # Explicit table name required because the class name # does not match up with the table name in this case. __PACKAGE__->meta->table('topics'); __PACKAGE__->meta->auto_initialize; package Product; use base qw(Rose::DB::Object); __PACKAGE__->meta->auto_initialize; package Price; use base qw(Rose::DB::Object); __PACKAGE__->meta->auto_initialize; Now we'll print the C class definition; print Product->meta->perl_class_definition(braces => 'bsd', indent => 2); The output looks like this: package Product; use strict; use base qw(Rose::DB::Object); __PACKAGE__->meta->setup ( table => 'products', columns => [ id => { type => 'integer', not_null => 1 }, name => { type => 'varchar', length => 32, not_null => 1 }, flag => { type => 'boolean', default => 'true', not_null => 1 }, status => { type => 'varchar', default => 'active', length => 32 }, topic_id => { type => 'integer' }, fk1 => { type => 'integer' }, fk2 => { type => 'integer' }, fk3 => { type => 'integer' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ], primary_key_columns => [ 'id' ], foreign_keys => [ code => { class => 'Code', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, topic => { class => 'Category', key_columns => { topic_id => 'id', }, }, ], relationships => [ prices => { class => 'Price', key_columns => { id => 'product_id' }, type => 'one to many', }, ], ); 1; Here's the output when the C parameter is explicitly set to false. print Product->meta->perl_class_definition(braces => 'bsd', indent => 2, use_setup => 0); Note that this approach is not recommended, but exists for historical reasons. package Product; use strict; use base qw(Rose::DB::Object); __PACKAGE__->meta->table('products'); __PACKAGE__->meta->columns ( id => { type => 'integer', not_null => 1 }, name => { type => 'varchar', length => 32, not_null => 1 }, flag => { type => 'boolean', default => 'true', not_null => 1 }, status => { type => 'varchar', default => 'active', length => 32 }, topic_id => { type => 'integer' }, fk1 => { type => 'integer' }, fk2 => { type => 'integer' }, fk3 => { type => 'integer' }, last_modified => { type => 'timestamp' }, date_created => { type => 'timestamp' }, ); __PACKAGE__->meta->primary_key_columns([ 'id' ]); __PACKAGE__->meta->foreign_keys ( code => { class => 'Code', key_columns => { fk1 => 'k1', fk2 => 'k2', fk3 => 'k3', }, }, topic => { class => 'Category', key_columns => { topic_id => 'id', }, }, ); __PACKAGE__->meta->relationships ( prices => { class => 'Price', key_columns => { id => 'product_id' }, type => 'one to many', }, ); __PACKAGE__->meta->initialize; 1; See the L section for more discussion of Perl code generation. =item B Auto-initialize the columns (if necessary), then return the Perl source code that is equivalent to the auto-initialization. PARAMS are optional name/value pairs that may include the following: =over 4 =item B The brace style to use in the generated Perl code. STYLE must be either "k&r" or "bsd". The default value is determined by the return value of the L class method. =item B If true, then the generated Perl code will be a method/arguments pair suitable for use as a parameter to L method. The default is false. =item B The integer number of spaces to use for each level of indenting in the generated Perl code. The default value is determined by the return value of the L class method. =back To see examples of the generated code, look in the documentation for the L method. =item B Auto-initialize the foreign keys (if necessary), then return the Perl source code that is equivalent to the auto-initialization. PARAMS are optional name/value pairs that may include the following: =over 4 =item B The brace style to use in the generated Perl code. STYLE must be either "k&r" or "bsd". The default value is determined by the return value of the L class method. =item B If true, then the generated Perl code will be a method/arguments pair suitable for use as a parameter to L method. The default is false. =item B The integer number of spaces to use for each level of indenting in the generated Perl code. The default value is determined by the return value of the L class method. =back To see examples of the generated code, look in the documentation for the L method. =item B Returns a Perl class definition for a L-derived class to manage objects of this L. If a single string is passed, it is taken as the value of the C parameter. PARAMS are optional name/value pairs that may include the following: =over 4 =item B The value of the L parameter that will be passed to the call to L's L method. Defaults to the return value of the L's L method. =item B The name of the manager class. Defaults to the return value of the L's L method. =item B The name of a single class or a reference to an array of class names to be included in the C<@ISA> array for the manager class. One of these classes must inherit from L. Defaults to the return value of the C L. =back For example, given this class: package Product; use Rose::DB::Object; our @ISA = qw(Rose::DB::Object); ... print Product->meta->perl_manager_class( class => 'Prod::Mgr', base_name => 'prod'); The following would be printed: package Prod::Mgr; use Rose::DB::Object::Manager; our @ISA = qw(Rose::DB::Object::Manager); sub object_class { 'Product' } __PACKAGE__->make_manager_methods('prod'); 1; =item B Auto-initialize the primary key column names (if necessary), then return the Perl source code that is equivalent to the auto-initialization. See the larger example in the documentation for the L method to see what the generated Perl code looks like. =item B Auto-initialize the relationships (if necessary), then return the Perl source code that is equivalent to the auto-initialization. PARAMS are optional name/value pairs that may include the following: =over 4 =item B The brace style to use in the generated Perl code. STYLE must be either "k&r" or "bsd". The default value is determined by the return value of the L class method. =item B If true, then the generated Perl code will be a method/arguments pair suitable for use as a parameter to L method. The default is false. =item B The integer number of spaces to use for each level of indenting in the generated Perl code. The default value is determined by the return value of the L class method. =back To see examples of the generated code, look in the documentation for the L method. =item B Auto-initialize the table name (if necessary), then return the Perl source code that is equivalent to the auto-initialization. PARAMS are optional name/value pairs that may include the following: =over 4 =item B The brace style to use in the generated Perl code. STYLE must be either "k&r" or "bsd". The default value is determined by the return value of the L class method. =item B If true, then the generated Perl code will be a method/arguments pair suitable for use as a parameter to L method. The default is false. =item B The integer number of spaces to use for each level of indenting in the generated Perl code. The default value is determined by the return value of the L class method. =back To see examples of the generated code, look in the documentation for the L method. =item B Auto-initialize the unique keys, then return the Perl source code that is equivalent to the auto-initialization. PARAMS are optional name/value pairs that may include the following: =over 4 =item B The brace style to use in the generated Perl code. STYLE must be either "k&r" or "bsd". The default value is determined by the return value of the L class method. =item B If true, then the generated Perl code will be a method/arguments pair suitable for use as a parameter to L method. The default is false. =item B The integer number of spaces to use for each level of indenting in the generated Perl code. The default value is determined by the return value of the L class method. =item B