DBIx-Class-Helpers-2.019002000755001750001750 012264533575 14305 5ustar00frewfrew000000000000README100644001750001750 263712264533575 15256 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002NAME DBIx::Class::Helpers - Simplify the common case stuff for DBIx::Class. VERSION version 2.019002 SYNOPSIS package MyApp::Schema::Result::Foo_Bar; __PACKAGE__->load_components(qw{Helper::JoinTable Core}); __PACKAGE__->join_table({ left_class => 'Foo', left_method => 'foo', right_class => 'Bar', right_method => 'bar', }); # define parent class package ParentSchema::Result::Bar; use strict; use warnings; use parent 'DBIx::Class'; __PACKAGE__->load_components('Core'); __PACKAGE__->table('Bar'); __PACKAGE__->add_columns(qw/ id foo_id /); __PACKAGE__->set_primary_key('id'); __PACKAGE__->belongs_to( foo => 'ParentSchema::Result::Foo', 'foo_id' ); # define subclass package MySchema::Result::Bar; use strict; use warnings; use parent 'ParentSchema::Result::Bar'; __PACKAGE__->load_components(qw{Helper::SubClass Core}); __PACKAGE__->subclass; SEE ALSO DBIx::Class::Helper::Row::JoinTable, DBIx::Class::Helper::ResultSet::SubClass, DBIx::Class::Helpers::Util AUTHOR Arthur Axel "fREW" Schmidt COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Changes100644001750001750 2206312264533575 15704 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002Revision history for DBIx-Class-Helpers 2.019002 2014-01-12 09:40:41 America/Chicago - Pick SQL for random row selection in a cleaner way - Stop using Class::MOP::load_class (RT#91035) - Really stop using RT 2.019001 2013-11-23 10:19:28 America/Chicago - Fix typo in ::CorrelateRelationship (Getty) 2.019000 2013-10-17 20:36:45 America/Chicago - Create clean_rs row shortcut (wreis) - Create DateTime schema helper (wreis) 2.018004 2013-10-07 15:23:39 America/Chicago - fix dep marked as test but actually runtime 2.018003 2013-09-26 08:06:03 America/Chicago - fix method shadowing with some helpers for ::Shortcut - ::OrderByMagic now correctly passes through arrayrefs (moltar) - ::OrderByMagic only prefixes with CSA when needed (moltar) 2.018002 2013-07-30 18:45:10 CST6CDT - ::Helper::ResultSet correctly uses all Helpers (reported by moltar) Note that some deprecated helpers were removed from ::ResultSet, so check your code to see if you use the as_virtual_view method. If you do, replace it with as_subselect_rs and you'll be fine. - Fix return precedence in test (Reini Urban) 2.018001 2013-07-02 20:40:18 CST6CDT - Fix bug related to inheriting from ::Shortcut 2.018000 2013-06-22 17:03:29 CST6CDT - Add ::ResultSet::Shortcut::OrderByMagic (moltar) - Add ::ResultSet::Shortcut::Prefetch (Wallas Reis) - Add ::ResultSet::Shortcut::HasRows (Wallas Reis) - Add ::ResultSet::Shortcut::Limit (Wallas Reis) - make ::ResultSet::Me more flexible (moltar) - Fix some warnings (when using deprecated modules) (good catch Bill Mosely) - Fix lots of docs (moltar, Gregor Herrmann, mauke) 2.017000 2013-04-20 10:37:04 CST6CDT - Add ::Schema::QuoteNames to force quote_names on - Add normalize_connect_info utilitiy 2.016006 2013-04-12 09:14:23 CST6CDT - Remove use of a private method, thus fixing Helpers on v0.08210 - Remove the last vestige of non-in-memory SQLite - Stop using RT for bugtracking 2.016005 2013-01-23 19:00:09 CST6CDT - Fix hash order dependency bug (Thanks Fitz Elliott!) 2.016004 2013-01-09 20:05:57 CST6CDT - Add more storages for ::ResultSet::Random (Thanks José Diaz Seng!) 2.016003 2012-12-07 15:54:29 CST6CDT - Fix bug in dup_check_source_auto and fk_check_source_auto. If any of the broken things were multiple they explode in the hashref. The solution is to force the values to be resultsets, which is how the helper is documented anyway. (thanks MST for finding this) 2.016002 2012-11-17 15:31:12 CST6CDT - Put MetaYAML back in dist 2.016001 2012-11-02 17:52:43 CST6CDT - fix OnColumnChange to work with relationship based updates so $artist->update({ cd => $cd_obj }) now correctly triggers a change. Thanks David Schmidt for the test - validate number of arguments to _change_column (David Schmidt) - fix name of Helper::ResultSet::Shortcut in SYNOPSIS 2.016000 2012-10-25 21:35:05 CST6CDT - Add Helper::ResultSet::Shortcut (Wes Malone) 2.015001 2012-09-13 21:19:40 America/Chicago - Correctly dep on Sub::Exporter::Progressive 0.001006 2.015000 2012-08-01 18:00:31 America/Chicago - Add order_by_visitor ::Util 2.014003 2012-07-28 14:21:26 America/Chicago - Add EXAMPLES to CorrelateRelationship 2.014002 2012-07-10 21:41:17 America/Chicago - Tests are fully in memory for speed and parallelization 2.014001 2012-07-03 08:34:21 America/Chicago - Stop breaking ::IgnoreWantarray with ::CorrelatedRelationship 2.014000 2012-06-30 00:16:13 America/Chicago - Add ::Row::ProxyResultSetUpdate helper - fully qualify columns in ::SelfResultSet 2.013003 2012-06-28 08:04:13 America/Chicago - Redist due to broken release 2.013002 2012-06-17 22:22:45 America/Chicago - Lots of misc documentation cleanup 2.013001 2012-06-11 17:40:04 America/Chicago - fix Changes (left off only change in 2.013000) 2.013000 2012-06-07 20:41:13 America/Chicago - Add Helper::Row::ProxyResultSetMethod 2.012000 2012-06-05 21:23:16 America/Chicago - Add Helper::ResultSet::NoColumns 2.011000 2012-06-03 16:12:54 America/Chicago - Add Helper::Row::SelfResultSet 2.010001 2012-05-26 10:58:50 America/Chicago - Make ::Schema::LintContents marginally more useful in that it no longer needlessly limits your sources to one moniker only 2.010000 2012-05-17 21:26:47 America/Chicago - Add Helper::Schema::LintContents 2.009001 2012-05-11 11:00:51 America/Chicago - Stupid doc fix 2.009000 2012-05-11 10:45:15 America/Chicago - add Helper::ResultSet::SearchOr component to avoid Union when possible - Simplify implementation of CorrelatedRelationship to work with more versions of DBIx::Class 2.008000 2012-05-09 13:36:28 America/Chicago - Add Helper::ResultSet::CorrelatedRelationship for easy correlated subqueries 2.007004 2012-04-11 19:53:51 America/Chicago - Fix ::OnColumnChange to not obliviate args passed to update 2.007003 2012-02-29 19:56:57 CST6CDT - Fix ::Row::NumifyGet breaking when using select/as or columns 2.007002 2012-01-09 16:23:08 CST6CDT - Fix POD in AutoRemoveColumns (mattp) - Fix multiple level deep Result namespaces (Siddhartha Basu) 2.007001 2011-08-17 22:34:54 CST6CDT - Fix dependency (add Carp::Clan) 2.007000 2011-03-14 21:43:20 CST6CDT - Add Helper::Row::RelationshipDWIM for handy definition of relationships - Significantly simplify implementation of ResultSet::ResultClassDWIM (thanks ribasushi) 2.006000 2011-01-31 18:06:56 CST6CDT - Add ResultSet::ResultClassDWIM to allow ::HashRefInflator (or ::HRI) - Add Schema::GenerateSource for handy addition of subclassed results 2.005000 2010-10-13 19:39:56 CST6CDT - Add ResultSet::Me to define predefined searches a more nicely - Fix DBIx::Class::Helper::ResultSet::Random to not base off Union - Fix DBIx::Class::Helper::ResultSet::Random for MSSQL 2.004000 2010-07-29 21:06:58 CST6CDT - Add Row::StorageValues - Add Row::OnColumnChange - Add Candy exports 2.003002 2010-03-24 23:48:52 CST6CDT - Give up on generating test database; I need to test this out with development releases 2.003001 2010-03-23 18:41:04 CST6CDT - Try again to correctly generate test database 2.003000 2010-03-22 21:27:14 CST6CDT - Fix tests to correctly generate test database - Stop bundling sqlite database with distribution! - Change DBICH::Union into DBICH::SetOperations (nothingmuch) 2.002002 2010-03-14 20:18:59 CST6CDT - DBIx::Class::Helper::ResultSet::Random declared RAND() as the random function for PostgreSQL when Pg uses RANDOM(). This broke any use of that resultset on PostgreSQL. -avar 2.002001 2010-03-13 00:46:30 CST6CDT - Fix my silly Union code - Fix error message from Util for incorrectly design namespace - Fix SYNOPSES to point to correct Components - Change as_virtual_view to just pass through to the cored version, as_subselect_rs 2.00200 2010-02-05 14:15:06 CST6CDT - Allow multiple levels for result in namespace for get_namespace_parts (aka, Foo::Schema::Result::Baz::Biff) (for melo) - Add Helper::Row::ToJSON - Autopopulate is_numeric correcly with NumifyGet - Fix mssql Random to use RAND() (pldoh, #RT53885) 2.00102 2010-01-15 21:50:20 CST6CDT - Better performance for some cases in NumifyGet - _determine_driver is better than _ensure_connected ( Random ) 2.00101 2010-01-15 02:14:55 CST6CDT - fix bug in Random where if a user calls random and schema isn't connected yet we get false storage type (thanks jnap) - fix NumifyGet for nullable and autoinc columns 2.00100 2010-01-13 23:37:34 CST6CDT - fix 'me' in RS::Union - change order in RS::Union so Unioning RS is first instead of last - add Row::NumifyGet - add docs to RS::Union to clarify some of the awesomeness that can be had - fixed union because it didn't actually work before (!!!) 2.00000 2009-12-30 13:02:23 CST6CDT - No new changes since dev release 2.00000_2 2009-12-29 18:45:15 CST6CDT - note added to SubClass disambiguating it from DBIx::Class::DynamicSubclass (thanks jnap) - random_order_by is now private (_random_order_by) - Depend on String::CamelCase now that it's fixed 2.00000_1 2009-12-28 11:40:43 CST6CDT - No longer depend on SQLT - Switch to more user friendly versioning - Allow multiple random rows from Random - Add the most excellent Helper::ResultSet::Union - namespace helpers 1.093501 2009-12-16 16:32:55 CST6CDT - Fix deps list 1.093500 2009-12-16 16:12:00 CST6CDT - Add IgnoreWantarray helper - Pull column def information from foreign tables for JoinTable helper, see pod in helper for details 0.093270 Mon Nov 23 10:45 2009 - Add Random helper - Clean up as_virtual_view with recommendation from ijw and ribasushi 0.093140 Tue Nov 10 09:32 2009 - Fix DBIC version dep - Get rid of some warnings from the test suite 0.093071 Tue Nov 03 20:53 2009 - Fix package of VirtualView - Add test so that won't happen again 0.093070 Mon Nov 02 23:16 2009 - Add virtual view method to clean SQL namespace - Add methods to generate has_many and many_to_many for join tables - Hopefully fix deps for real 0.093000 Sat Oct 26 19:40 2009 - Add parent as a dependency - Super basic POD cleanup - Tighter Restrictions on the namespaces of parent classes 0.092970 Sat Oct 24 02:41 2009 - Initial Release LICENSE100644001750001750 4372512264533575 15426 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End cpanfile100644001750001750 113112264533575 16066 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002requires 'DBIx::Class' => 0.08127; requires 'Carp::Clan' => 6.04; requires 'Sub::Exporter::Progressive' => 0.001006; requires 'Lingua::EN::Inflect' => 0; requires 'parent' => 0; requires 'String::CamelCase' => 0; requires 'namespace::clean' => 0.23; requires 'List::Util' => 0; requires 'DBIx::Class::Candy' => 0.001003; requires 'DBIx::Introspector'; requires 'Module::Runtime'; requires 'Try::Tiny'; on test => sub { requires 'Test::More' => 0.94; requires 'Test::Deep' => 0; requires 'DBD::SQLite' => 0; requires 'Test::Exception' => 0; requires 'DateTime::Format::SQLite' => 0; }; dist.ini100644001750001750 67212264533575 16017 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002name = DBIx-Class-Helpers author = Arthur Axel "fREW" Schmidt license = Perl_5 copyright_holder = Arthur Axel "fREW" Schmidt version = 2.019002 [NextRelease] [@Git] [@Basic] [GithubMeta] issues = 1 [MetaJSON] [PodWeaver] [OurPkgVersion] [ReadmeFromPod] [PodSyntaxTests] [=inc::Dist::Zilla::Plugin::DBICSgen] schema = TestSchema lib = lib lib = t/lib [Prereqs::FromCPANfile] META.yml100644001750001750 200012264533575 15627 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002--- abstract: 'Simplify the common case stuff for DBIx::Class.' author: - "Arthur Axel \"fREW\" Schmidt " build_requires: DBD::SQLite: 0 DateTime::Format::SQLite: 0 Test::Deep: 0 Test::Exception: 0 Test::More: 0.94 configure_requires: ExtUtils::MakeMaker: 6.30 dynamic_config: 0 generated_by: 'Dist::Zilla version 5.006, CPAN::Meta::Converter version 2.132830' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: DBIx-Class-Helpers requires: Carp::Clan: 6.04 DBIx::Class: 0.08127 DBIx::Class::Candy: 0.001003 DBIx::Introspector: 0 Lingua::EN::Inflect: 0 List::Util: 0 Module::Runtime: 0 String::CamelCase: 0 Sub::Exporter::Progressive: 0.001006 Try::Tiny: 0 namespace::clean: 0.23 parent: 0 resources: bugtracker: https://github.com/frioux/DBIx-Class-Helpers/issues homepage: https://github.com/frioux/DBIx-Class-Helpers repository: https://github.com/frioux/DBIx-Class-Helpers.git version: 2.019002 MANIFEST100644001750001750 734212264533575 15525 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002Changes LICENSE MANIFEST META.json META.yml Makefile.PL README contributing cpanfile dist.ini inc/Dist/Zilla/Plugin/DBICSgen.pm lib/DBIx/Class/Helper/IgnoreWantarray.pm lib/DBIx/Class/Helper/JoinTable.pm lib/DBIx/Class/Helper/Random.pm lib/DBIx/Class/Helper/ResultSet.pm lib/DBIx/Class/Helper/ResultSet/AutoRemoveColumns.pm lib/DBIx/Class/Helper/ResultSet/CorrelateRelationship.pm lib/DBIx/Class/Helper/ResultSet/IgnoreWantarray.pm lib/DBIx/Class/Helper/ResultSet/Me.pm lib/DBIx/Class/Helper/ResultSet/NoColumns.pm lib/DBIx/Class/Helper/ResultSet/Random.pm lib/DBIx/Class/Helper/ResultSet/RemoveColumns.pm lib/DBIx/Class/Helper/ResultSet/ResultClassDWIM.pm lib/DBIx/Class/Helper/ResultSet/SearchOr.pm lib/DBIx/Class/Helper/ResultSet/SetOperations.pm lib/DBIx/Class/Helper/ResultSet/Shortcut.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/AddColumns.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/Columns.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/Distinct.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/GroupBy.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/HRI.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/HasRows.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/Limit.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/OrderBy.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/OrderByMagic.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/Prefetch.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/Rows.pm lib/DBIx/Class/Helper/ResultSet/Union.pm lib/DBIx/Class/Helper/ResultSet/VirtualView.pm lib/DBIx/Class/Helper/Row/CleanResultSet.pm lib/DBIx/Class/Helper/Row/JoinTable.pm lib/DBIx/Class/Helper/Row/NumifyGet.pm lib/DBIx/Class/Helper/Row/OnColumnChange.pm lib/DBIx/Class/Helper/Row/ProxyResultSetMethod.pm lib/DBIx/Class/Helper/Row/ProxyResultSetUpdate.pm lib/DBIx/Class/Helper/Row/RelationshipDWIM.pm lib/DBIx/Class/Helper/Row/SelfResultSet.pm lib/DBIx/Class/Helper/Row/StorageValues.pm lib/DBIx/Class/Helper/Row/SubClass.pm lib/DBIx/Class/Helper/Row/ToJSON.pm lib/DBIx/Class/Helper/Schema/DateTime.pm lib/DBIx/Class/Helper/Schema/GenerateSource.pm lib/DBIx/Class/Helper/Schema/LintContents.pm lib/DBIx/Class/Helper/Schema/QuoteNames.pm lib/DBIx/Class/Helper/SubClass.pm lib/DBIx/Class/Helper/VirtualView.pm lib/DBIx/Class/Helpers.pm lib/DBIx/Class/Helpers/Util.pm t/bug-1.t t/lib/Lolbot.pm t/lib/ParentRS.pm t/lib/ParentSchema.pm t/lib/ParentSchema/Result.pm t/lib/ParentSchema/Result/Bar.pm t/lib/ParentSchema/Result/Foo.pm t/lib/RS.pm t/lib/TestSchema.pm t/lib/TestSchema/Result/Bar.pm t/lib/TestSchema/Result/Bloaty.pm t/lib/TestSchema/Result/Foo.pm t/lib/TestSchema/Result/Foo_Bar.pm t/lib/TestSchema/Result/Gnarly.pm t/lib/TestSchema/Result/Gnarly_Station.pm t/lib/TestSchema/Result/Station.pm t/lib/TestSchema/ResultSet.pm t/lib/TestSchema/ResultSet/Bloaty.pm t/lib/TestSchema/ResultSet/Foo.pm t/lib/TestSchema/ResultSet/Gnarly.pm t/lib/TestSchema/ResultSet/Station.pm t/lib/ddl.sql t/release-pod-syntax.t t/resultset/correlate-relationship.t t/resultset/ignore-wantarray.t t/resultset/me.t t/resultset/no-columns.t t/resultset/random.t t/resultset/remove-columns.t t/resultset/result-class-dwim.t t/resultset/search-or.t t/resultset/set-operations.t t/resultset/shortcut/add-columns.t t/resultset/shortcut/columns.t t/resultset/shortcut/distinct.t t/resultset/shortcut/group-by.t t/resultset/shortcut/has-rows.t t/resultset/shortcut/hri.t t/resultset/shortcut/limit.t t/resultset/shortcut/order-by-magic.t t/resultset/shortcut/order-by.t t/resultset/shortcut/prefetch.t t/resultset/shortcut/rows.t t/row/clean-resultset.t t/row/jointable.t t/row/numifyget.t t/row/on-column-change.t t/row/proxy-resultset-method.t t/row/proxy-resultset-update.t t/row/relationship-dwim.t t/row/self-resultset.t t/row/storage-values.t t/row/subclass.t t/row/to_json.t t/schema/datetime.t t/schema/generate-source.t t/schema/lint-contents.t t/utilities.t t000755001750001750 012264533575 14471 5ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002bug-1.t100644001750001750 13612264533575 15711 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/tuse strict; use warnings; use Test::More; use lib 't/lib'; use_ok 'RS'; done_testing; 1; META.json100644001750001750 354612264533575 16017 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002{ "abstract" : "Simplify the common case stuff for DBIx::Class.", "author" : [ "Arthur Axel \"fREW\" Schmidt " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 5.006, CPAN::Meta::Converter version 2.132830", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "DBIx-Class-Helpers", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.30" } }, "develop" : { "requires" : { "Test::Pod" : "1.41" } }, "runtime" : { "requires" : { "Carp::Clan" : "6.04", "DBIx::Class" : "0.08127", "DBIx::Class::Candy" : "0.001003", "DBIx::Introspector" : "0", "Lingua::EN::Inflect" : "0", "List::Util" : "0", "Module::Runtime" : "0", "String::CamelCase" : "0", "Sub::Exporter::Progressive" : "0.001006", "Try::Tiny" : "0", "namespace::clean" : "0.23", "parent" : "0" } }, "test" : { "requires" : { "DBD::SQLite" : "0", "DateTime::Format::SQLite" : "0", "Test::Deep" : "0", "Test::Exception" : "0", "Test::More" : "0.94" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/frioux/DBIx-Class-Helpers/issues" }, "homepage" : "https://github.com/frioux/DBIx-Class-Helpers", "repository" : { "type" : "git", "url" : "https://github.com/frioux/DBIx-Class-Helpers.git", "web" : "https://github.com/frioux/DBIx-Class-Helpers" } }, "version" : "2.019002" } lib000755001750001750 012264533575 15237 5ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/tRS.pm100644001750001750 14212264533575 16236 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/libpackage RS; use base 'ParentRS'; __PACKAGE__->load_components('Helper::ResultSet::Random'); 1; Makefile.PL100644001750001750 367312264533575 16351 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002 use strict; use warnings; use ExtUtils::MakeMaker 6.30; my %WriteMakefileArgs = ( "ABSTRACT" => "Simplify the common case stuff for DBIx::Class.", "AUTHOR" => "Arthur Axel \"fREW\" Schmidt ", "BUILD_REQUIRES" => {}, "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => "6.30" }, "DISTNAME" => "DBIx-Class-Helpers", "EXE_FILES" => [], "LICENSE" => "perl", "NAME" => "DBIx::Class::Helpers", "PREREQ_PM" => { "Carp::Clan" => "6.04", "DBIx::Class" => "0.08127", "DBIx::Class::Candy" => "0.001003", "DBIx::Introspector" => 0, "Lingua::EN::Inflect" => 0, "List::Util" => 0, "Module::Runtime" => 0, "String::CamelCase" => 0, "Sub::Exporter::Progressive" => "0.001006", "Try::Tiny" => 0, "namespace::clean" => "0.23", "parent" => 0 }, "TEST_REQUIRES" => { "DBD::SQLite" => 0, "DateTime::Format::SQLite" => 0, "Test::Deep" => 0, "Test::Exception" => 0, "Test::More" => "0.94" }, "VERSION" => "2.019002", "test" => { "TESTS" => "t/*.t t/resultset/*.t t/resultset/shortcut/*.t t/row/*.t t/schema/*.t" } ); my %FallbackPrereqs = ( "Carp::Clan" => "6.04", "DBD::SQLite" => 0, "DBIx::Class" => "0.08127", "DBIx::Class::Candy" => "0.001003", "DBIx::Introspector" => 0, "DateTime::Format::SQLite" => 0, "Lingua::EN::Inflect" => 0, "List::Util" => 0, "Module::Runtime" => 0, "String::CamelCase" => 0, "Sub::Exporter::Progressive" => "0.001006", "Test::Deep" => 0, "Test::Exception" => 0, "Test::More" => "0.94", "Try::Tiny" => 0, "namespace::clean" => "0.23", "parent" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); contributing100644001750001750 42512264533575 17001 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002 To Generate ddl.sql which will allow you to run prove -l use the following command: perl -Ilib -It/lib -MTestSchema -E'TestSchema->generate_ddl; my $t = TestSchema->connect; $t->deploy' Eventually that will be migrated into it's own Dzil plugin, but for now that should work utilities.t100644001750001750 1030312264533575 17046 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Exception; use Test::Deep; use DBIx::Class::Helpers::Util ':all'; my ($ns, $class) = get_namespace_parts('Project::Schema::Result::Child'); is $ns, 'Project::Schema::Result', 'namespace part of get_namespace_parts works'; is $class, 'Child', 'result part of get_namespace_parts works'; ($ns, $class) = get_namespace_parts('Project::Schema::Result::HouseHold::Child'); is $ns, 'Project::Schema::Result', 'namespace part of get_namespace_parts works'; is $class, 'HouseHold::Child', 'result part of get_namespace_parts works'; subtest is_load_namespaces => sub { ok is_load_namespaces('P::Result::Foo'), 'is_load_namespaces works when correct'; ok !is_load_namespaces('P::Foo'), 'is_load_namespaces works when incorrect'; ok is_load_namespaces('P::Result::Foo::Bar'), 'is_load_namespaces works with two levels namespace'; }; subtest is_not_load_namespaces => sub { ok is_not_load_namespaces('P::Foo'), 'is_not_load_namespaces works correct'; ok !is_not_load_namespaces('P::Result::Foo'), 'is_not_load_namespaces works when incorrect'; }; subtest assert_similar_namespaces => sub { lives_ok { assert_similar_namespaces('P::Foo', 'L::Bar') } 'assert_similar_namespaces works when both non-namespace'; lives_ok { assert_similar_namespaces('P::Result::Foo', 'L::Result::Bar') } 'assert_similar_namespaces works when both namespace'; dies_ok { assert_similar_namespaces('P::Foo', 'L::Result::Bar') } 'assert_similar_namespaces works when right is namespace'; dies_ok { assert_similar_namespaces('P::Result::Foo', 'L::Bar') } 'assert_similar_namespaces works when left is namespace'; lives_ok { assert_similar_namespaces('P::Result::Foo::Bar', 'L::Result::Foo::Bar')} 'assert_similar_namespaces works with two levels of right namespace'; }; subtest order_by_vistor => sub { my $complex_order_by = [ { -desc => [qw( foo bar )] }, 'baz', { -asc => 'biff' } ]; cmp_deeply( order_by_visitor($complex_order_by, sub{shift}), $complex_order_by, 'roundtrip' ); cmp_deeply( order_by_visitor('frew', sub{'bar'}), 'bar', 'simplest ever' ); cmp_deeply( order_by_visitor({ -asc => 'foo' }, sub{'bar'}), { -asc => 'bar' }, 'simple hash' ); cmp_deeply( order_by_visitor([{ -asc => 'foo' }, 'bar'], sub{ if ($_[0] eq 'foo') { return 'foot' } else { return $_[0] } }), [{ -asc => 'foot' }, 'bar'], 'typical' ); }; subtest normalize_connect_info => sub { subtest 'form 1' => sub { cmp_deeply( normalize_connect_info('dbi:foo'), { dsn => 'dbi:foo' }, 'dsn', ); cmp_deeply( normalize_connect_info('dbi:foo', 'user'), { dsn => 'dbi:foo', user => 'user', }, 'dsn, user', ); cmp_deeply( normalize_connect_info('dbi:foo', 'user', 'pass'), { dsn => 'dbi:foo', user => 'user', password => 'pass', }, 'dsn, user, pass', ); cmp_deeply( normalize_connect_info('dbi:foo', 'user', 'pass', { LongReadLen => 1 }, ), { dsn => 'dbi:foo', user => 'user', password => 'pass', LongReadLen => 1, }, 'dsn, user, pass, dbi_opts', ); cmp_deeply( normalize_connect_info('dbi:foo', 'user', 'pass', { LongReadLen => 1 }, { quote_names => 1 }, ), { dsn => 'dbi:foo', user => 'user', password => 'pass', LongReadLen => 1, quote_names => 1, }, 'all params', ); }; subtest 'form 2' => sub { my $s = sub {}; cmp_deeply( normalize_connect_info($s), { dbh_maker => $s }, 'just sub', ); cmp_deeply( normalize_connect_info($s, { quote_names => 1 }), { dbh_maker => $s, quote_names => 1 }, 'sub and options', ); }; }; done_testing; ddl.sql100644001750001750 335112264533575 16665 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/lib-- -- Created by SQL::Translator::Producer::SQLite -- Created on Sun Jan 12 09:40:42 2014 -- BEGIN TRANSACTION; -- -- Table: Bloaty -- CREATE TABLE Bloaty ( id NOT NULL, name NOT NULL, literature text, your_mom blob, PRIMARY KEY (id) ); -- -- Table: Gnarly -- CREATE TABLE Gnarly ( id NOT NULL, name NOT NULL, literature text, your_mom blob, PRIMARY KEY (id) ); -- -- Table: Station -- CREATE TABLE Station ( id NOT NULL, name NOT NULL, PRIMARY KEY (id) ); -- -- Table: Bar -- CREATE TABLE Bar ( id INTEGER PRIMARY KEY NOT NULL, foo_id NOT NULL, FOREIGN KEY (foo_id) REFERENCES Foo(id) ON DELETE CASCADE ON UPDATE CASCADE ); CREATE INDEX Bar_idx_foo_id ON Bar (foo_id); -- -- Table: Foo -- CREATE TABLE Foo ( id NOT NULL, bar_id integer NOT NULL, PRIMARY KEY (id), FOREIGN KEY (bar_id) REFERENCES Bar(id) ON DELETE CASCADE ON UPDATE CASCADE ); CREATE INDEX Foo_idx_bar_id ON Foo (bar_id); -- -- Table: Foo_Bar -- CREATE TABLE Foo_Bar ( foo_id NOT NULL, bar_id integer(12) NOT NULL, PRIMARY KEY (foo_id, bar_id), FOREIGN KEY (bar_id) REFERENCES Bar(id), FOREIGN KEY (foo_id) REFERENCES Foo(id) ); CREATE INDEX Foo_Bar_idx_bar_id ON Foo_Bar (bar_id); CREATE INDEX Foo_Bar_idx_foo_id ON Foo_Bar (foo_id); -- -- Table: Gnarly_Station -- CREATE TABLE Gnarly_Station ( gnarly_id integer NOT NULL, station_id integer NOT NULL, PRIMARY KEY (gnarly_id, station_id), FOREIGN KEY (gnarly_id) REFERENCES Gnarly(id) ON DELETE CASCADE ON UPDATE CASCADE, FOREIGN KEY (station_id) REFERENCES Station(id) ON DELETE CASCADE ON UPDATE CASCADE ); CREATE INDEX Gnarly_Station_idx_gnarly_id ON Gnarly_Station (gnarly_id); CREATE INDEX Gnarly_Station_idx_station_id ON Gnarly_Station (station_id); COMMIT; row000755001750001750 012264533575 15300 5ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/tto_json.t100644001750001750 206212264533575 17300 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/row#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; SIMPLE_JSON: { my $datas = [ map $_->TO_JSON, $schema->resultset('Bar')->search(undef, { order_by => 'id' })->all ]; cmp_deeply($datas, [{ id => 1, foo_id => 1, },{ id => 2, foo_id => 2, },{ id => 3, foo_id => 3, },{ id => 4, foo_id => 4, },{ id => 5, foo_id => 5, }], 'simple TO_JSON works'); } MORE_COMPLEX_JSON: { my $datas = [ map $_->TO_JSON, $schema->resultset('Gnarly')->search(undef, { order_by => 'id' })->all ]; cmp_deeply($datas, [{ id => 1, name => 'frew', your_mom => undef, },{ id => 2, name => 'frioux', your_mom => undef, },{ id => 3, name => 'frooh', your_mom => undef, }], 'complex TO_JSON works'); } done_testing; Lolbot.pm100644001750001750 16012264533575 17145 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/libpackage Lolbot; use DBIx::Class::Candy; table 'harrison'; column 'id'; column 'name'; primary_key 'id'; 1; resultset000755001750001750 012264533575 16523 5ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/tme.t100644001750001750 47512264533575 17437 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/resultset#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use TestSchema; my $schema = TestSchema->deploy_or_connect(); my $rs = $schema->resultset('Gnarly'); my $alias = $rs->current_source_alias; is $rs->me, "$alias.", 'me without args'; is $rs->me('col'), "$alias.col", 'me with args'; done_testing; subclass.t100644001750001750 134412264533575 17446 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/row#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use TestSchema; namespacing: { my $foo_rs = TestSchema->resultset('Foo'); my $bar_info = $foo_rs->result_source->relationship_info('bar'); is $bar_info->{class}, 'TestSchema::Result::Bar', 'namespacing seems to work'; my $bar_rs = TestSchema->resultset('Bar'); my $foo_info = $bar_rs->result_source->relationship_info('foo'); is $foo_info->{class}, 'TestSchema::Result::Foo', 'namespacing seems to work'; } table: { my $foo_rs = TestSchema->resultset('Foo'); is $foo_rs->result_source->from, 'Foo', 'set table works'; my $bar_rs = TestSchema->resultset('Bar'); is $bar_rs->result_source->from, 'Bar', 'set table works'; } done_testing; numifyget.t100644001750001750 244012264533575 17634 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/row#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use Test::Exception; use List::Util 'first'; use TestSchema; use B; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; # stolen from JSON::PP sub is_numeric { my $value = shift; my $b_obj = B::svref_2object(\$value); my $flags = $b_obj->FLAGS; return (( $flags & B::SVf_IOK or $flags & B::SVp_IOK or $flags & B::SVf_NOK or $flags & B::SVp_NOK ) and !($flags & B::SVf_POK )) } ok(is_numeric($schema->resultset('Foo')->first->bar_id),"bar_id has been 'numified' w/o is_numeric set"); for (map $_->id, $schema->resultset('Foo')->all) { ok(is_numeric($_), "id $_ has been 'numified'"); } for (map +{$_->get_columns}, $schema->resultset('Foo')->all) { ok(is_numeric($_->{id}), "id $_->{id} has been 'numified'"); } for (map +{$_->get_inflated_columns}, $schema->resultset('Foo')->all) { ok(is_numeric($_->{id}), "id $_->{id} has been 'numified'"); } for (map +{$_->get_inflated_columns}, $schema->resultset('Foo')->all) { ok(is_numeric($_->{id}), "id $_->{id} has been 'numified'"); } for ($schema->resultset('Foo')->search(undef, { columns => { lol => 'id' }, })->all) { lives_ok { $_->get_column('lol') } "doesn't break when using columns"; } done_testing; jointable.t100644001750001750 364512264533575 17604 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/row#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; { my $bar_rs = TestSchema->resultset('Foo_Bar'); is $bar_rs->result_source->from, 'Foo_Bar', 'set table works'; relationships: { my $bar_info = $bar_rs->result_source->relationship_info('bar'); is $bar_info->{class}, 'TestSchema::Result::Bar', 'namespace correctly defaulted'; my $foo_info = $bar_rs->result_source->relationship_info('foo'); is $foo_info->{class}, 'TestSchema::Result::Foo', 'namespace and method name correctly defaulted'; } cmp_deeply [ $bar_rs->result_source->primary_columns ], [qw{foo_id bar_id}], 'set primary keys works'; cmp_deeply $bar_rs->result_source->column_info('bar_id'), { data_type => 'integer', size => 12, }, 'bar_id infers column info correctly'; } { relationships: { my $g_rs = $schema->resultset('Gnarly'); my $s_rs = $schema->resultset('Station'); my $g_s_rs = $schema->resultset('Gnarly_Station'); cmp_deeply $g_s_rs->result_source->column_info('gnarly_id'), { data_type => 'integer', is_nullable => 0, is_numeric => 1, }, 'gnarly_id defaults column info correctly'; is $s_rs->result_source->relationship_info('gnarly_stations')->{class}, 'TestSchema::Result::Gnarly_Station', 'Left has_many defaulted correctly'; is $g_rs->result_source->relationship_info('gnarly_stations')->{class}, 'TestSchema::Result::Gnarly_Station', 'Right has_many defaulted correctly'; cmp_deeply [ map $_->id, $s_rs->find(1)->gnarlies ], [ 1, 2, 3 ], 'Left many_to_many defaulted correctly'; cmp_deeply [ map $_->id, $g_rs->find(1)->stations ], [ 1, 3 ], 'Right many_to_many defaulted correctly'; } } done_testing; ParentRS.pm100644001750001750 17712264533575 17420 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/libpackage ParentRS; use base 'DBIx::Class::ResultSet'; __PACKAGE__->load_components(qw/ Helper::ResultSet::Shortcut /); 1; TestSchema.pm100644001750001750 335212264533575 20000 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/libpackage TestSchema; use strict; use warnings; use File::Spec; our $VERSION = 0.001; use parent 'DBIx::Class::Schema'; __PACKAGE__->load_namespaces( default_resultset_class => 'ResultSet', ); __PACKAGE__->load_components(qw( Helper::Schema::LintContents Helper::Schema::QuoteNames )); sub upgrade_directory { './t/lib' } sub ddl_filename { return File::Spec->catfile(shift->upgrade_directory, 'ddl.sql'); } sub deploy_or_connect { my $self = shift; my $schema = $self->connect; $schema->deploy(); return $schema; } sub connect { my $self = shift; return $self->next::method('dbi:SQLite::memory:'); } sub generate_ddl { my $self = shift; my $schema = $self->connect; $schema->create_ddl_dir( 'SQLite', $schema->schema_version, $self->upgrade_directory, undef, { add_drop_table => 0, }, ); } sub prepopulate { my $self = shift; $self->resultset($_)->delete for qw{Bar Foo Gnarly_Station Bloaty Gnarly Station}; $self->populate( Gnarly => [ [qw{id name}], [1,'frew'], [2,'frioux'], [3,'frooh'], ]); $self->populate( Station => [ [qw{id name}], [1,'frew'], [2,'frioux'], [3,'frooh'], ]); $self->populate( Gnarly_Station => [ [qw{gnarly_id station_id}], [1,1], [1,3], [2,1], [3,1], ]); $self->populate(Bloaty => [ [qw{id name}], [1,1], [2,2], [3,3], [4,4], [5,5], ]); $self->populate(Foo => [ [qw{id bar_id}], [1,1], [2,2], [3,3], [4,4], [5,5], ]); $self->populate(Bar => [ [qw{id foo_id}], [1,1], [2,2], [3,3], [4,4], [5,5], ]); } 'kitten eater'; schema000755001750001750 012264533575 15731 5ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/tdatetime.t100644001750001750 74612264533575 20041 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/schemause strict; use warnings; use lib 't/lib'; use Test::More; use TestSchema; use DateTime; TestSchema->load_components('Helper::Schema::DateTime'); my $schema = TestSchema->deploy_or_connect(); isa_ok($schema->datetime_parser, 'DateTime::Format::SQLite'); my $dt = DateTime->now; my $s = $schema->format_datetime($dt); is( $schema->format_datetime($schema->parse_datetime($s)), $schema->format_datetime($dt), 'format_datetime and parse_datetime roundtrip', ); done_testing; random.t100644001750001750 114212264533575 20326 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/resultset#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Exception; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $row = $schema->resultset('Foo')->rand->single; # testing actual randomness is hard, and it's not actually random anyway, # so suck it. ok $row->id >= 1 && $row->id <= 5, 'row is one of the rows from the database'; my @rows = map $_->id, $schema->resultset('Foo')->rand(4)->all; ok @rows == 4, 'correct amount of rows selected'; for (@rows) { ok $_ >= 1 && $_ <= 5, 'row is one of the rows from the database'; } done_testing; ParentSchema.pm100644001750001750 15212264533575 20265 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/libpackage ParentSchema; use parent 'DBIx::Class::Schema'; __PACKAGE__->load_namespaces(); 'kitten eater'; storage-values.t100644001750001750 117612264533575 20573 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/row#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $first = $schema->resultset('Bar')->search(undef, { order_by => 'id' })->first; is($first->foo_id, 1, 'foo_id starts as 1'); is($first->get_storage_value('foo_id'), 1, 'foo_id storage value starts as 1'); $first->foo_id(2); is($first->foo_id, 2, 'foo_id changes to 2'); is($first->get_storage_value('foo_id'), 1, 'foo_id storage value is still 1'); $first->update; is($first->get_storage_value('foo_id'), 2, 'foo_id storage value is updated to 2'); done_testing; self-resultset.t100644001750001750 165512264533575 20615 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/row#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; $schema->resultset('Foo_Bar')->delete; $schema->resultset('Foo_Bar')->populate([ [qw(foo_id bar_id)], [1, 2], [2, 1], [4, 5], ]); subtest 'single pk column' => sub { for ($schema->resultset('Bar')->all) { subtest 'Bar.id: ' . $_->id => sub { is ($_->self_rs->count, 1, 'single row in self_rs'); is ($_->self_rs->single->id, $_->id, 'id matches'); }; } }; subtest 'multi pk' => sub { for ($schema->resultset('Foo_Bar')->all) { subtest 'Foo_Bar: ' . $_->foo_id . ' ' . $_->bar_id => sub { is ($_->self_rs->count, 1, 'single row in self_rs'); is ($_->self_rs->single->foo_id, $_->foo_id, 'foo_id matches'); is ($_->self_rs->single->bar_id, $_->bar_id, 'bar_id matches'); }; } }; done_testing; release-pod-syntax.t100644001750001750 45012264533575 20521 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use Test::More; eval "use Test::Pod 1.41"; plan skip_all => "Test::Pod 1.41 required for testing POD" if $@; all_pod_files_ok(); search-or.t100644001750001750 173712264533575 20743 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/resultset#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Exception; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; $schema->resultset('Gnarly')->update({ literature => 'boo.' }); $schema->resultset('Gnarly')->create({ id => 4, name => 'fismboc' }); my $rs = $schema->resultset('Gnarly')->search({ literature => 'boo.' }); is($rs->count, 3, 'base rs has three results'); my $rs2 = $schema->resultset('Gnarly')->search({ name => 'frew' }); is($rs2->count, 1, 'rs2 has 1 result'); my $rs3 = $schema->resultset('Gnarly')->search({ name => 'frioux' }); is($rs3->count, 1, 'rs3 has 1 result'); my $rs4 = $schema->resultset('Gnarly')->search({ name => 'fismboc' }); is($rs4->count, 1, 'rs4 has 1 result'); is($rs->search_or([$rs2, $rs3, $rs4])->count, 2, 'only two things are in all of rs and in any of rs2, rs3, or rs4'); dies_ok { $rs->search_or([$schema->resultset('Bloaty')]) } 'or-ing differing ResultSets dies'; done_testing; clean-resultset.t100644001750001750 42012264533575 20713 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/row#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; cmp_deeply $schema->resultset('Bar'), $schema->resultset('Bar')->first->clean_rs; done_testing; no-columns.t100644001750001750 53712264533575 21127 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/resultset#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Gnarly')->no_columns->search(undef, { result_class => '::HRI', }); cmp_deeply([$rs->all], [ { }, { }, { } ], 'no columns selected'); done_testing; on-column-change.t100644001750001750 562312264533575 20765 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/row#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use Test::Exception; use TestSchema; use TestSchema::Result::Bar; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; throws_ok( sub { TestSchema::Result::Bar->after_column_change( foo_id => { method => sub { 1; } }, id => { method => sub { 1; } }, ); }, qr/Invalid number of arguments\. One \$column => \$args pair at a time\./, ); TestSchema::Result::Bar->after_column_change( foo_id => { method => sub { push @TestSchema::Result::Bar::events, [after_foo_id => $_[1], $_[2]] } }, ); TestSchema::Result::Bar->after_column_change( id => { method => sub { is($schema->storage->{transaction_depth}, 1, 'transactions turned on for id'); push @TestSchema::Result::Bar::events, [after_id => $_[1], $_[2]] }, txn_wrap => 1, }, ); my $another_txn_test = sub { is($schema->storage->{transaction_depth}, 0, 'transactions turned off for non-txn') }; TestSchema::Result::Bar->around_column_change( foo_id => { method => sub { my ( $self, $fn, $old, $new ) = @_; push @TestSchema::Result::Bar::events, [pre_around_foo_id => $old, $new]; $another_txn_test->(); $fn->(); push @TestSchema::Result::Bar::events, [post_around_foo_id => $old, $new]; }, }, ); my $first = $schema->resultset('Bar')->search(undef, { order_by => 'id' })->first; is($first->foo_id, 1, 'foo_id starts as 1'); $first->foo_id(2); $first->update; is($first->foo_id, 2, 'foo_id is updated to 2'); $another_txn_test = sub {}; cmp_deeply([ [ 'before_foo_id', 1, 2 ], # comes from TestSchema::Result::Bar [ 'pre_around_foo_id', 1, 2 ], [ 'post_around_foo_id', 1, 2 ], [ 'after_foo_id', 2, 2 ], ], \@TestSchema::Result::Bar::events, 'subs fire in correct order and with correct args'); @TestSchema::Result::Bar::events = (); $first->update({ foo_id => 1, id => 99 }); is($first->foo_id, 1, 'foo_id is updated'); is($first->id, 99, 'id is updated'); cmp_deeply([ [ 'before_foo_id', 2, 1 ], [ 'pre_around_foo_id', 2, 1 ], [ 'post_around_foo_id', 2, 1 ], [ 'after_id', undef, 99 ], [ 'after_foo_id', 1, 1 ] ], \@TestSchema::Result::Bar::events, '... even with args passed to update'); TestSchema::Result::Foo->after_column_change( bar_id => { method => sub { die }, txn_wrap => 1, }, ); my $foo = $schema->resultset('Foo')->search(undef, { order_by => 'id' })->first; my $bar = $schema->resultset('Bar')->search( { id => { '!=' => $first->id } } )->first; dies_ok( sub { $foo->update({ bar_id => $bar->id }); }, 'after_column_change method triggered when updating via foreign key column', ); dies_ok( sub { $foo->update({ bar => $first }); }, 'after_column_change method triggered when updating via relationship accessor', ); done_testing; lint-contents.t100644001750001750 467112264533575 21067 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/schema#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; subtest 'null_check_source_auto' => sub { my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; local $schema->source('Gnarly')->column_info('literature')->{is_nullable} = 0; cmp_deeply [map +{ $_ => $schema->null_check_source_auto($_)->count }, sort $schema->sources], [ { Bar => 0 }, { Bloaty => undef }, { Foo => 0 }, { Foo_Bar => 0 }, { Gnarly => 3 }, { Gnarly_Station => 0 }, { Station => 0 }, ], 'errors for Gnarly null_check_source'; }; subtest 'dub_check_source_auto' => sub { my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; $schema->resultset('Gnarly')->create({ id => 100 + $_, name => 'foo' }) for 1, 2; $schema->resultset('Gnarly')->create({ id => 200 + $_, name => 'bar' }) for 1, 2; $schema->source('Gnarly')->add_unique_constraint(['name']); cmp_deeply [map { my $source = $_; my $constraints = $schema->dup_check_source_auto($source); map { my $constraint_name = $_; +{ "$source $constraint_name" => $constraints->{$constraint_name}->count } } sort keys %$constraints; } grep { $_ ne 'Bloaty' } sort $schema->sources], [ { "Bar primary" => 0 }, { "Foo primary" => 0 }, { "Foo_Bar primary" => 0 }, { "Gnarly Gnarly_name" => 2 }, { "Gnarly primary" => 0 }, { "Gnarly_Station primary" => 0 }, { "Station primary" => 0 }, ], 'Gnarly_name duplicated twice'; }; subtest 'fk_check_source_auto' => sub { my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; $schema->resultset('Foo_Bar')->delete; $schema->resultset('Foo_Bar')->create({ foo_id => 1010, bar_id => 2020, }); $schema->resultset('Foo_Bar')->create({ foo_id => 1111, bar_id => 2222, }); cmp_deeply [map { my $source = $_; my $constraints = $schema->fk_check_source_auto($source); map { my $fk_constraint_name = $_; +{ "$source $fk_constraint_name" => $constraints->{$fk_constraint_name}->count } } sort keys %$constraints; } grep { $_ ne 'Bloaty' } sort $schema->sources], [ { "Bar foo" => 0 }, { "Foo bar" => 0 }, { "Foo_Bar bar" => 2 }, { "Foo_Bar foo" => 2 }, { "Gnarly_Station gnarly" => 0 }, { "Gnarly_Station station" => 0 }, ], 'foo and bar constraints broken'; }; done_testing; relationship-dwim.t100644001750001750 50412264533575 21243 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/row#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $r = $schema->resultset('Bar')->result_class; ok $r->has_relationship('foo'), 'has Foo'; ok $r->has_relationship('foos'), 'has foos'; done_testing; Class000755001750001750 012264533575 16627 5ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIxHelpers.pm100644001750001750 307512264533575 20734 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Classpackage DBIx::Class::Helpers; use strict; use warnings; # ABSTRACT: Simplify the common case stuff for DBIx::Class. our $VERSION = '2.019002'; # VERSION 1; # this class isn't meant to be used __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helpers - Simplify the common case stuff for DBIx::Class. =head1 VERSION version 2.019002 =head1 SYNOPSIS package MyApp::Schema::Result::Foo_Bar; __PACKAGE__->load_components(qw{Helper::JoinTable Core}); __PACKAGE__->join_table({ left_class => 'Foo', left_method => 'foo', right_class => 'Bar', right_method => 'bar', }); # define parent class package ParentSchema::Result::Bar; use strict; use warnings; use parent 'DBIx::Class'; __PACKAGE__->load_components('Core'); __PACKAGE__->table('Bar'); __PACKAGE__->add_columns(qw/ id foo_id /); __PACKAGE__->set_primary_key('id'); __PACKAGE__->belongs_to( foo => 'ParentSchema::Result::Foo', 'foo_id' ); # define subclass package MySchema::Result::Bar; use strict; use warnings; use parent 'ParentSchema::Result::Bar'; __PACKAGE__->load_components(qw{Helper::SubClass Core}); __PACKAGE__->subclass; =head1 SEE ALSO L, L, L =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut shortcut000755001750001750 012264533575 20376 5ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/resultsethri.t100644001750001750 57612264533575 21475 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/resultset/shortcut#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); cmp_deeply [$rs->hri->all], [$rs->search(undef,{ result_class => 'DBIx::Class::ResultClass::HashRefInflator' })->all], 'hri works the same'; done_testing; generate-source.t100644001750001750 67112264533575 21332 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/schemause strict; use warnings; use lib 't/lib'; use Test::More; use TestSchema; TestSchema->load_components('Helper::Schema::GenerateSource'); TestSchema->generate_source(PsychoKiller => 'Lolbot'); my $class = TestSchema->class('PsychoKiller'); ok($class, 'PsychoKiller gets registered'); ok($class->isa('Lolbot'), 'PsychoKiller inherits from Lolbot'); ok(ref($class) ne 'Lolbot', '... but PsychoKiller is not just a Lolbot'); done_testing; rows.t100644001750001750 50212264533575 21672 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/resultset/shortcut#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); cmp_deeply [$rs->rows(2)->all], [$rs->search({},{rows => 2})->all], 'rows works the same'; done_testing; set-operations.t100644001750001750 570612264533575 22034 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/resultset#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use Test::Exception; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo')->search({ id => 1 }); my $rs2 = $schema->resultset('Foo')->search({ id => { '>=' => 3 } }); my $rs3 = $schema->resultset('Foo')->search({ id => [ 1, 3 ] }); cmp_deeply [ sort map $_->id, $rs2->union($rs2)->all ], [3, 4, 5], 'union returns correct values'; cmp_deeply [ sort map $_->id, $rs2->union_all($rs2)->all ], [3, 3, 4, 4, 5, 5], 'union returns correct values'; cmp_deeply [ sort map $_->id, $rs2->union($rs)->all ], [1, 3, 4, 5], 'union returns correct values'; cmp_deeply [ sort map $_->id, $rs3->union($rs)->all ], [1, 3], 'union returns correct values'; cmp_deeply [ sort map $_->id, $rs3->union_all($rs)->all ], [1, 1, 3], 'union returns correct values'; cmp_deeply [ sort map $_->id, $rs2->intersect($rs)->all ], [], 'intersect returns correct values'; cmp_deeply [ sort map $_->id, $rs3->intersect($rs)->all ], [1], 'intersect returns correct values'; cmp_deeply [ sort map $_->id, $rs->intersect($rs3)->all ], [1], 'intersect returns correct values'; cmp_deeply [ sort map $_->id, $rs2->intersect($rs3)->all ], [3], 'intersect returns correct values'; cmp_deeply [ sort map $_->id, $rs3->intersect($rs2)->all ], [3], 'intersect returns correct values'; cmp_deeply [ sort map $_->id, $rs2->except($rs)->all ], [3, 4, 5], 'except returns correct values'; cmp_deeply [ sort map $_->id, $rs->except($rs2)->all ], [1], 'except returns correct values'; cmp_deeply [ sort map $_->id, $rs3->except($rs)->all ], [3], 'except returns correct values'; cmp_deeply [ sort map $_->id, $rs->except($rs3)->all ], [], 'except returns correct values'; cmp_deeply [ sort map $_->id, $rs2->except($rs3)->all ], [4, 5], 'except returns correct values'; cmp_deeply [ sort map $_->id, $rs3->except($rs2)->all ], [1], 'except returns correct values'; dies_ok { my $rs3 = $rs->search(undef, { columns => ['id'] }); $rs->union($rs3) ; } 'unioning differing ColSpecs dies'; dies_ok { $rs->union($rs->search_rs(undef, { result_class => 'DBIx::Class::ResultClass::HashRefInflator'})) ; } 'unioning with differing ResultClasses dies'; dies_ok { $rs->union($schema->resultset('Bar')) } 'unioning differing ResultSets dies'; { my $rs3 = $rs->search(undef, { columns => ['id'], '+select' => [\'"foo" as station'], '+as' => ['station'], }); my $rs4 = $schema->resultset('Bar')->search(undef, { columns => ['id'], '+select' => [\'"bar" as station'], '+as' => ['station'], }); $rs3->result_class('DBIx::Class::ResultClass::HashRefInflator'); $rs4->result_class('DBIx::Class::ResultClass::HashRefInflator'); my $rs5 = $rs3->union($rs4); lives_ok { [ $rs5->all ] } q{unioning differing ResultSets does not die when you know what you're doing}; } done_testing; remove-columns.t100644001750001750 265012264533575 22026 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/resultset#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use Test::Exception; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; RemoveColumns: { my $rs = $schema->resultset('Foo')->search({ id => 1 }, { result_class => 'DBIx::Class::ResultClass::HashRefInflator', 'remove_columns' => ['bar_id'], }); cmp_deeply [$rs->all], [{ id => 1 }], 'remove_columns works'; cmp_deeply [$rs->search({ id => { '!=' => 4 } })->all], [{ id => 1 }], 'chaining remove_columns works';; cmp_deeply [ $rs->search({ id => { '!=' => 4 } }, { '+columns' => 'bar_id' })->all ], [{ bar_id => 1, id => 1 }], 'chaining and +columns works with remove_columns'; } AutoRemoveColumns: { my $rs = $schema->resultset('Bloaty')->search({ id => 1 }, { result_class => 'DBIx::Class::ResultClass::HashRefInflator', }); cmp_deeply [$rs->all], [{ id => 1 }], 'remove_columns works'; cmp_deeply [$rs->search({ id => { '!=' => 4 } })->all], [{ id => 1 }], 'chaining remove_columns works';; cmp_deeply [ $rs->search({ id => { '!=' => 4 } }, { '+columns' => 'name' })->all ], [{ name => 1, id => 1 }], 'chaining and +columns works with remove_columns'; } done_testing; limit.t100644001750001750 46512264533575 22026 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/resultset/shortcut#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); cmp_deeply [$rs->rows(2)->all], [$rs->limit(2)->all], 'limit works the same'; done_testing; ParentSchema000755001750001750 012264533575 17611 5ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/libResult.pm100644001750001750 27212264533575 21546 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/lib/ParentSchemapackage ParentSchema::Result; use base 'DBIx::Class::Core'; __PACKAGE__->load_components('Helper::Row::RelationshipDWIM'); sub default_result_namespace { 'ParentSchema::Result' } 1; TestSchema000755001750001750 012264533575 17277 5ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/libResultSet.pm100644001750001750 25012264533575 21704 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/lib/TestSchemapackage TestSchema::ResultSet; use strict; use warnings; use base 'DBIx::Class::ResultSet'; __PACKAGE__->load_components('Helper::ResultSet::IgnoreWantarray'); 1; ignore-wantarray.t100644001750001750 101212264533575 22333 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/resultset#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my ($rs) = $schema->resultset('Foo')->search; my ($rs2) = $schema->resultset('Bar')->search; my ($rs3) = $schema->resultset('Foo')->first->bars; my ($rs4) = $schema->resultset('Bar')->first->foos; isa_ok $rs, 'DBIx::Class::ResultSet'; isa_ok $rs2, 'DBIx::Class::ResultSet'; isa_ok $rs3, 'DBIx::Class::ResultSet'; isa_ok $rs4, 'DBIx::Class::ResultSet'; done_testing; columns.t100644001750001750 54012264533575 22362 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/resultset/shortcut#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); cmp_deeply [$rs->columns(['bar_id'])->all], [$rs->search(undef,{columns => ['bar_id']})->all], 'columns works the same'; done_testing; proxy-resultset-method.t100644001750001750 123412264533575 22314 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/row#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $g = $schema->resultset('Gnarly')->search({ id => 1 })->single; subtest 'unloaded data' => sub { is($g->id_plus_one, 2, 'basic test'); is($g->id_plus_two, 3, 'slot and specified method'); is($g->id_plus_two, 3, 'slot and specified method(2)'); }; my $g2 = $schema->resultset('Gnarly')->with_id_plus_one->search({ id => 2 })->single; subtest 'loaded data' => sub { is($g2->id_plus_one, 3, 'basic'); is($g2->id_plus_two, 4, 'slot and specified method'); }; done_testing; proxy-resultset-update.t100644001750001750 113612264533575 22317 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/row#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; $schema->resultset('Bloaty')->search({ id => 1000 })->delete; my $row = $schema->resultset('Bloaty')->create({ id => 1000, name => 'woo', literature => 'bored', your_mom => 'hyuug', }); $row->name('woot'); $row->update({ literature => 'exciting' }); cmp_deeply( [{ name => 'woot', literature => 'exciting', }], \@TestSchema::ResultSet::Bloaty::stuff, 'update correctly proxied', ); done_testing; Result000755001750001750 012264533575 20555 5ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/lib/TestSchemaBar.pm100644001750001750 70312264533575 21737 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/lib/TestSchema/Resultpackage TestSchema::Result::Bar; use DBIx::Class::Candy -base => 'ParentSchema::Result::Bar', -components => [qw( Helper::Row::ToJSON Helper::Row::SubClass Helper::Row::OnColumnChange Helper::Row::SelfResultSet Helper::Row::CleanResultSet )]; our @events; subclass; before_column_change(foo_id => { method => 'before_foo_id', }); sub before_foo_id { push @events, [before_foo_id => $_[1], $_[2]] } 1; Foo.pm100644001750001750 36712264533575 21764 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/lib/TestSchema/Resultpackage TestSchema::Result::Foo; use DBIx::Class::Candy -base => 'ParentSchema::Result::Foo', -components => [qw( Helper::Row::NumifyGet Helper::Row::SubClass Helper::Row::OnColumnChange )]; subclass; 1; Helpers000755001750001750 012264533575 20231 5ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/ClassUtil.pm100644001750001750 1324612264533575 21672 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helperspackage DBIx::Class::Helpers::Util; use strict; use warnings; # ABSTRACT: Helper utilities for DBIx::Class components our $VERSION = '2.019002'; # VERSION use Sub::Exporter::Progressive -setup => { exports => [ qw( get_namespace_parts is_load_namespaces is_not_load_namespaces assert_similar_namespaces order_by_visitor normalize_connect_info ), ], }; sub get_namespace_parts { my $package = shift; if ($package =~ m/(^[\w:]+::Result)::([\w:]+)$/) { return ($1, $2); } else { die "$package doesn't look like ".'$namespace::Result::$resultclass'; } } sub is_load_namespaces { my $namespace = shift; $namespace =~ /^[\w:]+::Result::[\w:]+$/; } sub is_not_load_namespaces { my $namespace = shift; $namespace =~ /^([\w:]+)::[\w]+$/ and $1 !~ /::Result/; } sub assert_similar_namespaces { my $ns1 = shift; my $ns2 = shift; die "Namespaces $ns1 and $ns2 are dissimilar" unless is_load_namespaces($ns1) and is_load_namespaces($ns2) or is_not_load_namespaces($ns1) and is_not_load_namespaces($ns2); } sub _order_by_visitor_HASHREF { my ($hash, $callback) = @_; my %ret; # there should only be one k/v pair, but DBIC checks for that and I'm not # going to reimplement said check here. for my $k (keys %$hash) { my $v = $hash->{$k}; if (my $v_ref = ref $v) { if ($v_ref eq 'ARRAY' ) { $ret{$k} = [ map $callback->($_), @$v ] } else { die 'this should never happen' } } else { $ret{$k} = ($callback->($v)); } } \%ret } sub order_by_visitor { my ($order, $callback) = @_; if (my $top_ref = ref $order) { if ($top_ref eq 'HASH') { return _order_by_visitor_HASHREF($order, $callback) } elsif ($top_ref eq 'ARRAY') { return [ map { if (my $ref = ref $_) { if ($ref eq 'HASH') { _order_by_visitor_HASHREF($_, $callback) } else { die 'this should never happen' } } else { $callback->($_) } } @$order ]; } } else { return $callback->($order) } } sub normalize_connect_info { my %all; if (!ref $_[0]) { %all = ( dsn => $_[0], ( exists $_[1] ? (user => $_[1], exists $_[2] ? ( password => $_[2], ( exists $_[3] && ref $_[3] ? %{$_[3]} : () ), ( exists $_[4] && ref $_[4] ? %{$_[4]} : () ), ) : () ) : () ), ) } elsif (ref $_[0] eq 'CODE') { %all = ( dbh_maker => $_[0], ( exists $_[1] && ref $_[1] ? %{$_[1]} : () ), ) } else { %all = %{$_[0]} } return \%all; } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helpers::Util - Helper utilities for DBIx::Class components =head1 VERSION version 2.019002 =head1 SYNOPSIS use DBIx::Class::Helpers::Util ':all'; my ($namespace, $class) = get_namespace_parts('MyApp:Schema::Person'); is $namespace, 'MyApp::Schema'; is $class, 'Person'; if (is_load_namespaces('MyApp::Schema::Result::Person')) { print 'correctly structured project'; } if (is_not_load_namespaces('MyApp::Schema::Person')) { print 'incorrectly structured project'; } if (assert_similar_namespaces('MyApp::Schema::Person', 'FooApp::Schema::People')) { print 'both projects are structured similarly'; } if (assert_similar_namespaces('MyApp::Schema::Result::Person', 'FooApp::Schema::Result::People')) { print 'both projects are structured similarly'; } # in a resultset sub search { my ($self, $search, $attrs) = @_; $attrs->{order_by} = order_by_visitor($attrs->{order_by}, sub { my $field = shift; return 'foo_bar' if $field eq 'foo.bar'; return $field; }) if $attrs && $attrs->{order_by}; $self->next::method($search, $attrs); } # in schema sub connection { my $self = shift; my $args = normalize_connect_info(@_); $args->{quote_names} = 1; $self->next::method($args) } =head1 DESCRIPTION A collection of various helper utilities for L stuff. Probably only useful for components. =head1 EXPORTS =head2 order_by_visitor This function allows you to easily transform C clauses. See L for example. =head2 get_namespace_parts Returns the namespace and class name of a package. See L for example. =head2 is_load_namespaces Returns true if a package is structured in a way that would work for load_namespaces. See L for example. =head2 is_not_load_namespaces Returns true if a package is structured in a way that would not work for load_namespaces. See L for example. =head2 assert_similar_namespaces Dies if both packages are structured in the same way. The same means both are load_namespaces or both are not. See L for example. =head2 normalize_connect_info Takes L that can be passed to connect and normalizes them into the final and simplest form, a single hashref. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut result-class-dwim.t100644001750001750 140312264533575 22425 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/resultset#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); my $expect = [ $rs->search(undef, { result_class => 'DBIx::Class::ResultClass::HashRefInflator' })->all ]; ok scalar @{$expect}, 'make sure test environment is not ruined forever'; cmp_deeply [ $rs->search(undef, { result_class => '::HashRefInflator' })->all ], $expect, '::HashRefInflator works'; cmp_deeply [ $rs->search(undef, { result_class => '::HashRefInflator' })->all ], $expect, '::HRI works'; my $rs2 = $rs->search(undef); $rs2->result_class('::HRI'); cmp_deeply [ $rs2->all ], $expect, '::HRI also works from result_class accessor'; done_testing; prefetch.t100644001750001750 53212264533575 22503 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/resultset/shortcut#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); cmp_deeply [$rs->prefetch('bar')->all], [$rs->search(undef,{prefetch => 'bar' })->all], 'prefetch works the same'; done_testing; order-by.t100644001750001750 102012264533575 22437 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/resultset/shortcut#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); cmp_deeply [$rs->order_by({ -desc => 'me.id' })->all], [$rs->search({},{order_by => { -desc => 'me.id' }})->all], 'hashref order_by works the same'; cmp_deeply [$rs->order_by(['me.id'])->all], [$rs->search({},{order_by => { -asc => 'me.id' }})->all], 'arrayref order_by works the same'; done_testing; has-rows.t100644001750001750 40612264533575 22446 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/resultset/shortcut#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); ok($rs->has_rows, 'check rs has rows'); done_testing; group-by.t100644001750001750 54112264533575 22447 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/resultset/shortcut#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); cmp_deeply [$rs->group_by(['me.id'])->all], [$rs->search(undef,{group_by => ['me.id']})->all], 'group_by works the same'; done_testing; distinct.t100644001750001750 51612264533575 22526 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/resultset/shortcut#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); cmp_deeply [$rs->distinct->all], [$rs->search(undef,{distinct => 1})->all], 'distinct works the same'; done_testing; Helper000755001750001750 012264533575 20046 5ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/ClassRandom.pm100644001750001750 212312264533575 21762 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helperpackage DBIx::Class::Helper::Random; use parent 'DBIx::Class::Helper::ResultSet::Random'; our $VERSION = '2.019002'; # VERSION use Carp::Clan; carp 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 3; croak 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 4; # ABSTRACT: (DEPRECATED) Get random rows from a ResultSet 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::Random - (DEPRECATED) Get random rows from a ResultSet =head1 VERSION version 2.019002 =head1 DESCRIPTION This component has been suplanted by L. In the next major version (3) we will begin issuing a warning on it's use. In the major version after that (4) we will remove it entirely. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Result000755001750001750 012264533575 21067 5ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/lib/ParentSchemaBar.pm100644001750001750 47412264533575 22256 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/lib/ParentSchema/Resultpackage ParentSchema::Result::Bar; use DBIx::Class::Candy -base => 'ParentSchema::Result'; table 'Bar'; column id => { data_type => 'integer', size => 12, }; column foo_id => { keep_storage_value => 1, }; primary_key 'id'; belongs_to foo => '::Foo', 'foo_id'; has_many foos => '::Foo', 'bar_id'; 1; Foo.pm100644001750001750 45612264533575 22275 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/lib/ParentSchema/Resultpackage ParentSchema::Result::Foo; use DBIx::Class::Candy; table 'Foo'; column id => { is_numeric => 1, }; column bar_id => { data_type => 'integer' }; primary_key 'id'; belongs_to bar => 'ParentSchema::Result::Bar', 'bar_id'; has_many bars => 'ParentSchema::Result::Bar', 'foo_id'; 1; Plugin000755001750001750 012264533575 20213 5ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/inc/Dist/ZillaDBICSgen.pm100644001750001750 302212264533575 22224 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/inc/Dist/Zilla/Pluginpackage inc::Dist::Zilla::Plugin::DBICSgen; use strict; use warnings; # ABSTRACT: common tests to check syntax of your modules use Moose; use Module::Runtime 'use_module'; require lib; with 'Dist::Zilla::Role::FileGatherer'; has schema => ( is => 'ro', isa => 'Str', required => 1, ); has lib => ( is => 'rw', isa => 'ArrayRef', default => sub { [qw{lib}] }, ); sub mvp_multivalue_args { qw(lib) } unlink 't/lib/ddl.sql'; sub gather_files { my $self = shift; lib->import(@{$self->lib}); my $schema = $self->schema; use_module($schema); $schema->generate_ddl; my $file = Dist::Zilla::File::OnDisk->new(name => $schema->ddl_filename); $self->add_file($file); } no Moose; __PACKAGE__->meta->make_immutable; 1; =begin Pod::Coverage gather_files mvp_multivalue_args =end Pod::Coverage =head1 SYNOPSIS In your dist.ini: [CompileTests] skip = Test$ =head1 DESCRIPTION This is an extension of L, providing the following files: =over 4 =item * t/00-compile.t - a standard test to check syntax of bundled modules This test will find all modules and scripts in your dist, and try to compile them one by one. This means it's a bit slower than loading them all at once, but it will catch more errors. =back This plugin accepts the following options: =over 4 =item * skip: a regex to skip compile test for modules matching it. The match is done against the module name (C), not the file path (F). =back Gnarly.pm100644001750001750 104012264533575 22502 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/lib/TestSchema/Resultpackage TestSchema::Result::Gnarly; use DBIx::Class::Candy -components => [qw( Helper::Row::ToJSON Helper::Row::ProxyResultSetMethod )]; table 'Gnarly'; column 'id'; column 'name'; column literature => { data_type => 'text', is_nullable => 1, }; column your_mom => { data_type => 'blob', is_nullable => 1, is_serializable => 1, }; primary_key 'id'; proxy_resultset_method 'id_plus_one'; proxy_resultset_method id_plus_two => { resultset_method => 'id_plus_two', slot => 'plus2', }; 1; Bloaty.pm100644001750001750 60012264533575 22461 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/lib/TestSchema/Resultpackage TestSchema::Result::Bloaty; use DBIx::Class::Candy -components => [ 'Helper::Row::ProxyResultSetUpdate' ]; table 'Bloaty'; column 'id'; column name => { remove_column => 1, }; column literature => { data_type => 'text', is_nullable => 1, }; column your_mom => { data_type => 'blob', is_nullable => 1, is_serializable => 1, }; primary_key 'id'; 1; ResultSet000755001750001750 012264533575 21231 5ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/lib/TestSchemaFoo.pm100644001750001750 44012264533575 22430 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/lib/TestSchema/ResultSetpackage TestSchema::ResultSet::Foo; use strict; use warnings; use parent 'TestSchema::ResultSet'; __PACKAGE__->load_components(qw{ Helper::ResultSet::RemoveColumns Helper::ResultSet::Union Helper::ResultSet::Random Helper::ResultSet::ResultClassDWIM Helper::ResultSet::Shortcut }); 1; SubClass.pm100644001750001750 213512264533575 22264 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helperpackage DBIx::Class::Helper::SubClass; use parent 'DBIx::Class::Helper::Row::SubClass'; our $VERSION = '2.019002'; # VERSION use Carp::Clan; carp 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 3; croak 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 4; # ABSTRACT: (DEPRECATED) Convenient subclassing with DBIx::Class 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::SubClass - (DEPRECATED) Convenient subclassing with DBIx::Class =head1 VERSION version 2.019002 =head1 DESCRIPTION This component has been suplanted by L. In the next major version (3) we will begin issuing a warning on it's use. In the major version after that (4) we will remove it entirely. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut add-columns.t100644001750001750 62412264533575 23113 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/resultset/shortcut#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); cmp_deeply [$rs->search(undef, { columns => 'id' })->add_columns('bar_id')->all], [$rs->search(undef, { columns => ['id', 'bar_id'] })->all], 'add_columns works the same'; done_testing; Station.pm100644001750001750 20412264533575 22650 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/lib/TestSchema/Resultpackage TestSchema::Result::Station; use DBIx::Class::Candy; table 'Station'; column 'id'; column 'name'; primary_key 'id'; 1; Foo_Bar.pm100644001750001750 37712264533575 22551 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/lib/TestSchema/Resultpackage TestSchema::Result::Foo_Bar; use DBIx::Class::Candy -components => [ 'Helper::Row::JoinTable', 'Helper::Row::SelfResultSet', ]; join_table({ left_class => 'Foo', right_class => 'Bar', right_method => 'bar', }); 1; ResultSet.pm100644001750001750 353412264533575 22503 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helperpackage DBIx::Class::Helper::ResultSet; use parent qw{ DBIx::Class::Helper::ResultSet::AutoRemoveColumns DBIx::Class::Helper::ResultSet::CorrelateRelationship DBIx::Class::Helper::ResultSet::IgnoreWantarray DBIx::Class::Helper::ResultSet::Me DBIx::Class::Helper::ResultSet::NoColumns DBIx::Class::Helper::ResultSet::Random DBIx::Class::Helper::ResultSet::RemoveColumns DBIx::Class::Helper::ResultSet::ResultClassDWIM DBIx::Class::Helper::ResultSet::SearchOr DBIx::Class::Helper::ResultSet::SetOperations DBIx::Class::Helper::ResultSet::Shortcut }; # ABSTRACT: All the ResultSet Helpers in one place our $VERSION = '2.019002'; # VERSION 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet - All the ResultSet Helpers in one place =head1 VERSION version 2.019002 =head1 DESCRIPTION This is just a simple Helper helper that includes all of the ResultSet Helpers in one convenient module. It does not include deprecated helpers. =head2 NOTE You probably want this applied to your entire schema. The most convenient way to do that is to make a base ResultSet and inherit from that in all of your custom ResultSets as well has make it the default ResultSet for the non-custom ResultSets. Example: package My::App::Schema::ResultSet; use strict; use warnings; use base 'DBIx::Class::ResultSet'; __PACKAGE__->load_components('Helper::ResultSet'); 1; package My::App::Schema; use base 'DBIx::Class::Schema'; My::App::Schema->load_namespaces( default_resultset_class => 'ResultSet', ); 1; =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut JoinTable.pm100644001750001750 214712264533575 22417 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helperpackage DBIx::Class::Helper::JoinTable; use parent 'DBIx::Class::Helper::Row::JoinTable'; our $VERSION = '2.019002'; # VERSION use Carp::Clan; carp 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 3; croak 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 4; # ABSTRACT: (DEPRECATED) Easily set up join tables with DBIx::Class 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::JoinTable - (DEPRECATED) Easily set up join tables with DBIx::Class =head1 VERSION version 2.019002 =head1 DESCRIPTION This component has been suplanted by L. In the next major version (3) we will begin issuing a warning on it's use. In the major version after that (4) we will remove it entirely. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Row000755001750001750 012264533575 20615 5ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/HelperToJSON.pm100644001750001750 676312264533575 22403 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/Rowpackage DBIx::Class::Helper::Row::ToJSON; use strict; use warnings; our $VERSION = '2.019002'; # VERSION use parent 'DBIx::Class'; # ABSTRACT: Remove the boilerplate from your TO_JSON functions __PACKAGE__->mk_group_accessors(inherited => '_serializable_columns'); my $dont_serialize = { text => 1, ntext => 1, blob => 1, }; sub _is_column_serializable { my ( $self, $column ) = @_; my $info = $self->column_info($column); if (!defined $info->{is_serializable}) { if (defined $info->{data_type} && $dont_serialize->{lc $info->{data_type}} ) { $info->{is_serializable} = 0; } else { $info->{is_serializable} = 1; } } return $info->{is_serializable}; } sub serializable_columns { my $self = shift; if (!$self->_serializable_columns) { $self->_serializable_columns([ grep $self->_is_column_serializable($_), $self->result_source->columns ]); } return $self->_serializable_columns; } sub TO_JSON { my $self = shift; return { map +($_ => $self->$_), @{$self->serializable_columns} }; } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::Row::ToJSON - Remove the boilerplate from your TO_JSON functions =head1 VERSION version 2.019002 =head1 SYNOPSIS package MyApp::Schema::Result::KittenRobot; use base 'DBIx::Class::Core'; __PACKAGE__->load_components(qw{Helper::Row::ToJSON}); __PACKAGE__->table('KittenRobot'); __PACKAGE__->add_columns( id => { data_type => 'integer', is_auto_increment => 1, }, kitten => { data_type => 'integer', }, robot => { data_type => 'text', is_nullable => 1, }, your_mom => { data_type => 'blob', is_nullable => 1, is_serializable => 1, }, ); 1; This helper adds a JSON method like the following: sub TO_JSON { return { id => $self->id, kitten => $self->kitten, # robot => $self->robot, # <-- doesn't serialize text columns your_mom => $self->your_mom, # <-- normally wouldn't but explicitly # asked for in the column spec above } } =head1 METHODS =head2 _is_column_serializable $self->_is_column_serializable('kitten') returns true if a column should be serializable or not. Currently this marks everything as serializable unless C is set to false, or C is a C, C, or C columns. If you wanted to only have explicit serialization you might override this method to look like this: sub _is_column_serializable { my ( $self, $column ) = @_; my $info = $self->column_info($column); return defined $info->{is_serializable} && $info->{is_serializable}; } =head2 serializable_columns $self->serializable_columns simply returns a list of columns that TO_JSON should serialize. =head2 TO_JSON $self->TO_JSON returns a hashref representing your object. Override this method to add data to the returned hashref: sub TO_JSON { my $self = shift; return { customer_name => $self->customer->name, %{ $self->next::method }, } } =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut correlate-relationship.t100644001750001750 213312264533575 23526 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/resultset#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Gnarly')->search(undef, { '+columns' => { old_gnarlies => $schema->resultset('Gnarly') ->correlate('gnarly_stations') ->search({ station_id => { '>' => 2 }}) ->count_rs->as_query, new_gnarlies => $schema->resultset('Gnarly') ->correlate('gnarly_stations') ->search({ station_id => { '<=' => 2 }}) ->count_rs->as_query, }, result_class => '::HRI', }); cmp_deeply([$rs->all], [ { id => 1, literature => undef, name => "frew", new_gnarlies => 1, old_gnarlies => 1, your_mom => undef }, { id => 2, literature => undef, name => "frioux", new_gnarlies => 1, old_gnarlies => 0, your_mom => undef }, { id => 3, literature => undef, name => "frooh", new_gnarlies => 1, old_gnarlies => 0, your_mom => undef } ], 'relationship correlated correctly'); done_testing; Gnarly.pm100644001750001750 126112264533575 23163 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/lib/TestSchema/ResultSetpackage TestSchema::ResultSet::Gnarly; use strict; use warnings; # intentionally not using TestSchema::ResultSet use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components(qw{ Helper::ResultSet::Me Helper::ResultSet::ResultClassDWIM Helper::ResultSet::CorrelateRelationship Helper::ResultSet::SearchOr Helper::ResultSet::NoColumns }); sub with_id_plus_one { my $self = shift; my $id = $self->me . 'id'; $self->search(undef, { '+columns' => { id_plus_one => \"$id + 1", }, }) } sub id_plus_two { my $self = shift; my $id = $self->me . 'id'; $self->search(undef, { '+columns' => { plus2 => \"$id + 2", }, }) } 1; Bloaty.pm100644001750001750 45012264533575 23140 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/lib/TestSchema/ResultSetpackage TestSchema::ResultSet::Bloaty; use strict; use warnings; use parent 'TestSchema::ResultSet'; __PACKAGE__->load_components(qw{ Helper::ResultSet::AutoRemoveColumns }); our @stuff; sub update { my ($self, $rest) = @_; push @stuff, $rest; $self->next::method($rest); } 1; VirtualView.pm100644001750001750 213512264533575 23026 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helperpackage DBIx::Class::Helper::VirtualView; use parent 'DBIx::Class::Helper::ResultSet::VirtualView'; our $VERSION = '2.019002'; # VERSION use Carp::Clan; carp 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 3; croak 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 4; # ABSTRACT: (DEPRECATED) Clean up your SQL namespace 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::VirtualView - (DEPRECATED) Clean up your SQL namespace =head1 VERSION version 2.019002 =head1 DESCRIPTION This component has been suplanted by L. In the next major version (3) we will begin issuing a warning on it's use. In the major version after that (4) we will remove it entirely. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut order-by-magic.t100644001750001750 141512264533575 23525 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/resultset/shortcut#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); my %tests = ( 'id' => [{ -asc => 'me.id' }], '!id' => [{ -desc => 'me.id' }], 'id,!bar_id' => [{ -asc => 'me.id' }, { -desc => 'bar_id' }], 'id, !bar_id' => [{ -asc => 'me.id' }, { -desc => 'bar_id' }], 'id ,!bar_id' => [{ -asc => 'me.id' }, { -desc => 'bar_id' }], 'id , !bar_id' => [{ -asc => 'me.id' }, { -desc => 'bar_id' }], ); while (my ($order, $expect) = each(%tests)) { cmp_deeply [$rs->order_by($order)->all], [$rs->search({},{order_by => $expect})->all], "order_by works: $order"; } done_testing; Station.pm100644001750001750 23412264533575 23327 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/lib/TestSchema/ResultSetpackage TestSchema::ResultSet::Station; use strict; use warnings; # intentionally not using TestSchema::ResultSet use parent 'DBIx::Class::ResultSet'; 1; SubClass.pm100644001750001750 726112264533575 23040 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/Rowpackage DBIx::Class::Helper::Row::SubClass; use strict; use warnings; # ABSTRACT: Convenient subclassing with DBIx::Class our $VERSION = '2.019002'; # VERSION use DBIx::Class::Helpers::Util qw{get_namespace_parts assert_similar_namespaces}; use DBIx::Class::Candy::Exports; export_methods [qw(subclass generate_relationships set_table)]; sub subclass { my $self = shift; my $namespace = shift; $self->set_table; $self->generate_relationships($namespace); } sub generate_relationships { my $self = shift; my ($namespace) = get_namespace_parts($self); foreach my $rel ($self->relationships) { my $rel_info = $self->relationship_info($rel); my $class = $rel_info->{class}; assert_similar_namespaces($self, $class); my (undef, $result) = get_namespace_parts($class); $self->add_relationship( $rel, "${namespace}::$result", $rel_info->{cond}, $rel_info->{attrs} ); }; } sub set_table { my $self = shift; $self->table($self->table); } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::Row::SubClass - Convenient subclassing with DBIx::Class =head1 VERSION version 2.019002 =head1 SYNOPSIS # define parent class package ParentSchema::Result::Bar; use strict; use warnings; use parent 'DBIx::Class'; __PACKAGE__->load_components('Core'); __PACKAGE__->table('Bar'); __PACKAGE__->add_columns(qw/ id foo_id /); __PACKAGE__->set_primary_key('id'); __PACKAGE__->belongs_to( foo => 'ParentSchema::Result::Foo', 'foo_id' ); # define subclass package MySchema::Result::Bar; use strict; use warnings; use parent 'ParentSchema::Result::Bar'; __PACKAGE__->load_components(qw{Helper::Row::SubClass Core}); __PACKAGE__->subclass; or with L: # define subclass package MySchema::Result::Bar; use DBIx::Class::Candy -base => 'ParentSchema::Result::Bar', -components => ['Helper::Row::SubClass']; subclass; =head1 DESCRIPTION This component is to allow simple subclassing of L Result classes. =head1 METHODS =head2 subclass This is probably the method you want. You call this in your child class and it imports the definitions from the parent into itself. =head2 generate_relationships This is where the cool stuff happens. This assumes that the namespace is laid out in the recommended C format. If the parent has C related to C, and you inherit from C in C, you will automatically get the relationship to C. =head2 set_table This is a super basic method that just sets the current classes' table to the parent classes' table. =head1 CANDY EXPORTS If used in conjunction with L this component will export: =over =item join_table =item subclass =item generate_relationships =item set_table =back =head1 NOTE This Component is mostly aimed at those who want to subclass parts of a schema, maybe for sharing a login system in a few different projects. Do not confuse it with L, which solves an entirely different problem. DBIx::Class::DynamicSubclass is for when you want to store a few very similar classes in the same table (Employee, Person, Boss, etc) whereas this component is merely for reusing an existing schema. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut ResultSet000755001750001750 012264533575 22000 5ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/HelperMe.pm100644001750001750 353412264533575 23044 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSetpackage DBIx::Class::Helper::ResultSet::Me; use strict; use warnings; # ABSTRACT: Define predefined searches more nicely our $VERSION = '2.019002'; # VERSION sub me { join('.', shift->current_source_alias, shift || q{}) } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::Me - Define predefined searches more nicely =head1 VERSION version 2.019002 =head1 SYNOPSIS # note that this is normally a component for a ResultSet package MySchema::ResultSet::Bar; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; use constant CANDY => 1; __PACKAGE__->load_components('Helper::ResultSet::Me'); sub candy { $_[0]->search({ $_[0]->me.'type' => CANDY }) } sub cake { $_[0]->search({ $_[0]->me('type') => CAKE }) } # in code using resultset: my $candy_bars = $schema->resultset('Bar')->candy; my $cake_bars = $schema->resultset('Bar')->cake; =head1 DESCRIPTION This component allows slightly nicer predefined search definition. See L for a nice way to apply it to your entire schema. It defines a single method that is shorter and (to most) clearer than L, which is what it uses for the L method. =head1 METHODS =head2 me Merely returns the SQL namespace for the current search with a C<.> at the end, allowing internal resultset methods to be defined with C<< $self->me >> instead of C<< $self->current_source_alias . q(.) >>. Also, if you pass it a single argument it will append that to the returned string. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut NumifyGet.pm100644001750001750 363612264533575 23232 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/Rowpackage DBIx::Class::Helper::Row::NumifyGet; use strict; use warnings; use Try::Tiny; # ABSTRACT: Force numeric "context" on numeric columns our $VERSION = '2.019002'; # VERSION sub get_column { my ($self, $col) = @_; my $value = $self->next::method($col); $value += 0 if defined($value) and # for nullable and autoinc fields try { $self->_is_column_numeric($col) }; return $value; } sub get_columns { my ($self, $col) = @_; my %columns = $self->next::method($col); for (keys %columns) { $columns{$_} += 0 if defined($columns{$_}) and # for nullable and autoinc fields try { $self->_is_column_numeric($_) }; } return %columns; } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::Row::NumifyGet - Force numeric "context" on numeric columns =head1 VERSION version 2.019002 =head1 SYNOPSIS package MyApp::Schema::Result::Foo_Bar; __PACKAGE__->load_components(qw{Helper::Row::NumifyGet Core}); __PACKAGE__->table('Foo'); __PACKAGE__->add_columns( foo => { data_type => 'integer', is_nullable => 0, is_numeric => 1, }, ); sub TO_JSON { return { foo => $self->foo, # this becomes 0 instead of "0" due to context } } =head1 METHODS =head2 get_column This is the method that "converts" the values. It just checks for C and if that is true it will numify the value. =head2 get_columns This method also "converts" values, but this one is called a lot more rarely. Again, It just checks for C and if that is true it will numify the value. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut JoinTable.pm100644001750001750 2130412264533575 23202 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/Rowpackage DBIx::Class::Helper::Row::JoinTable; use strict; use warnings; # ABSTRACT: Easily set up join tables with DBIx::Class our $VERSION = '2.019002'; # VERSION use DBIx::Class::Helpers::Util 'get_namespace_parts'; use Lingua::EN::Inflect (); use String::CamelCase (); use DBIx::Class::Candy::Exports; export_methods [qw( join_table generate_primary_key generate_has_manys generate_many_to_manys generate_relationships set_table add_join_columns )]; sub _pluralize { my $self = shift; my $original = shift or return; return join q{_}, split /\s+/, Lingua::EN::Inflect::PL(join q{ }, split /_/, $original); } sub _defaults { my ($self, $params) = @_; $params->{namespace} ||= [ get_namespace_parts($self) ]->[0]; $params->{left_method} ||= String::CamelCase::decamelize($params->{left_class}); $params->{right_method} ||= String::CamelCase::decamelize($params->{right_class}); $params->{self_method} ||= String::CamelCase::decamelize($self); $params->{left_method_plural} ||= $self->_pluralize($params->{left_method}); $params->{right_method_plural} ||= $self->_pluralize($params->{right_method}); $params->{self_method_plural} ||= $self->_pluralize($params->{self_method}); return $params; } sub join_table { my ($self, $params) = @_; $self->set_table($params); $self->add_join_columns($params); $self->generate_relationships($params); $self->generate_primary_key($params); } sub generate_primary_key { my ($self, $params) = @_; $self->_defaults($params); $self->set_primary_key("$params->{left_method}_id", "$params->{right_method}_id"); } sub generate_has_manys { my ($self, $params) = @_; $params = $self->_defaults($params); "$params->{namespace}::$params->{left_class}"->has_many( $params->{self_method} => $self, "$params->{left_method}_id" ); "$params->{namespace}::$params->{right_class}"->has_many( $params->{self_method} => $self, "$params->{right_method}_id" ); } sub generate_many_to_manys { my ($self, $params) = @_; $params = $self->_defaults($params); "$params->{namespace}::$params->{left_class}"->many_to_many( $params->{right_method_plural} => $params->{self_method}, $params->{right_method} ); "$params->{namespace}::$params->{right_class}"->many_to_many( $params->{left_method_plural} => $params->{self_method}, $params->{left_method} ); } sub generate_relationships { my ($self, $params) = @_; $params = $self->_defaults($params); $self->belongs_to( $params->{left_method} => "$params->{namespace}::$params->{left_class}", "$params->{left_method}_id" ); $self->belongs_to( $params->{right_method} => "$params->{namespace}::$params->{right_class}", "$params->{right_method}_id" ); } sub set_table { my ($self, $params) = @_; $self->table("$params->{left_class}_$params->{right_class}"); } sub _add_join_column { my ($self, $params) = @_; my $class = $params->{class}; my $method = $params->{method}; my $default = { data_type => 'integer', is_nullable => 0, is_numeric => 1, }; $self->ensure_class_loaded($class); my @datas = qw{is_nullable extra data_type size is_numeric}; my @class_column_info = ( map { my $info = $class->column_info($_); my $result = {}; my $defined = undef; for (@datas) { if (defined $info->{$_}) { $defined = 1; $result->{$_} = $info->{$_}; } } $result = $default unless $defined; $result; } $class->primary_columns ); if (@class_column_info == 1) { $self->add_columns( "${method}_id" => $class_column_info[0], ); } else { my $i = 0; for (@class_column_info) { $i++; $self->add_columns( "${method}_${i}_id" => $_ ); } } } sub add_join_columns { my ($self, $params) = @_; $params = $self->_defaults($params); my $l_class = "$params->{namespace}::$params->{left_class}"; my $r_class = "$params->{namespace}::$params->{right_class}"; $self->_add_join_column({ class => $l_class, method => $params->{left_method} }); $self->_add_join_column({ class => $r_class, method => $params->{right_method} }); } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::Row::JoinTable - Easily set up join tables with DBIx::Class =head1 VERSION version 2.019002 =head1 SYNOPSIS package MyApp::Schema::Result::Foo_Bar; __PACKAGE__->load_components(qw{Helper::Row::JoinTable Core}); __PACKAGE__->join_table({ left_class => 'Foo', left_method => 'foo', right_class => 'Bar', right_method => 'bar', }); # the above is the same as: __PACKAGE__->table('Foo_Bar'); __PACKAGE__->add_columns( foo_id => { data_type => 'integer', is_nullable => 0, is_numeric => 1, }, bar_id => { data_type => 'integer', is_nullable => 0, is_numeric => 1, }, ); $self->set_primary_key(qw{foo_id bar_id}); __PACKAGE__->belongs_to( foo => 'MyApp::Schema::Result::Foo' 'foo_id'); __PACKAGE__->belongs_to( bar => 'MyApp::Schema::Result::Bar' 'bar_id'); or with L: package MyApp::Schema::Result::Foo_Bar; use DBIx::Class::Candy -components => ['Helper::Row::JoinTable']; join_table { left_class => 'Foo', left_method => 'foo', right_class => 'Bar', right_method => 'bar', }; =head1 METHODS All the methods take a configuration hashref that looks like the following: { left_class => 'Foo', left_method => 'foo', # see NOTE left_method_plural => 'foos', # see NOTE, not required, used for # many_to_many rel name in right_class # which is not generated by default right_class => 'Bar', right_method => 'bar', # see NOTE right_method_plural => 'bars', # see NOTE, not required, used for # many_to_many rel name in left_class # which is not generated by default namespace => 'MyApp', # default is guessed via *::Foo self_method => 'foobars', # not required, used for setting the name of the # join table's relationship in a has_many # which is not generated by default } =head2 join_table This is the method that you probably want. It will set your table, add columns, set the primary key, and set up the relationships. =head2 add_join_columns Adds two non-nullable integer fields named C<"${left_method}_id"> and C<"${right_method}_id"> respectively. =head2 generate_has_manys Installs methods into C and C to get to the join table. The methods will be named what's passed into the configuration hashref as C. =head2 generate_many_to_manys Installs many_to_many methods into C and C. The methods will be named what's passed into the configuration hashref as C for the C and C for the C. =head2 generate_primary_key Sets C<"${left_method}_id"> and C<"${right_method}_id"> to be the primary key. =head2 generate_relationships This adds relationships to C<"${namespace}::Schema::Result::$left_class"> and C<"${namespace}::Schema::Result::$left_class"> respectively. =head2 set_table This method sets the table to "${left_class}_${right_class}". =head1 CANDY EXPORTS If used in conjunction with L this component will export: =over =item join_table =item generate_primary_key =item generate_has_manys =item generate_many_to_manys =item generate_relationships =item set_table =item add_join_columns =back =head2 NOTE This module uses L to default the method names and uses L for pluralization. =head1 CHANGES BETWEEN RELEASES =head2 Changes since 0.* Originally this module would use data_type => 'integer', is_nullable => 0, is_numeric => 1, for all joining columns. It now infers C, C, C, and C from the foreign tables. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut IgnoreWantarray.pm100644001750001750 216712264533575 23666 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helperpackage DBIx::Class::Helper::IgnoreWantarray; use parent 'DBIx::Class::Helper::ResultSet::IgnoreWantarray'; our $VERSION = '2.019002'; # VERSION use Carp::Clan; carp 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 3; croak 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 4; # ABSTRACT: (DEPRECATED) Get rid of search context issues 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::IgnoreWantarray - (DEPRECATED) Get rid of search context issues =head1 VERSION version 2.019002 =head1 DESCRIPTION This component has been suplanted by L. In the next major version (3) we will begin issuing a warning on it's use. In the major version after that (4) we will remove it entirely. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Union.pm100644001750001750 216512264533575 23572 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSetpackage DBIx::Class::Helper::ResultSet::Union; use parent 'DBIx::Class::Helper::ResultSet::SetOperations'; our $VERSION = '2.019002'; # VERSION use Carp::Clan; carp 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 3; croak 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 4; # ABSTRACT: (DEPRECATED) Get rid of search context issues 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::Union - (DEPRECATED) Get rid of search context issues =head1 VERSION version 2.019002 =head1 DESCRIPTION This component has been suplanted by L. In the next major version (3) we will begin issuing a warning on it's use. In the major version after that (4) we will remove it entirely. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Schema000755001750001750 012264533575 21246 5ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/HelperDateTime.pm100644001750001750 176312264533575 23447 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/Schemapackage DBIx::Class::Helper::Schema::DateTime; # ABSTRACT: DateTime helper use strict; use warnings; our $VERSION = '2.019002'; # VERSION sub datetime_parser { return shift->storage->datetime_parser } sub parse_datetime { return shift->datetime_parser->parse_datetime(@_) } sub format_datetime { return shift->datetime_parser->format_datetime(@_) } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::Schema::DateTime - DateTime helper =head1 VERSION version 2.019002 =head1 SYNOPSIS package MyApp::Schema; __PACKAGE__->load_components('Helper::Schema::DateTime'); ... $schema->resultset('Book')->search({ written_on => $schema->format_datetime(DateTime->now) }); =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Gnarly_Station.pm100644001750001750 74512264533575 24176 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/t/lib/TestSchema/Resultpackage TestSchema::Result::Gnarly_Station; use DBIx::Class::Candy -components => ['Helper::Row::JoinTable']; my $config = { left_class => 'Gnarly', left_method => 'gnarly', left_method_plural => 'gnarlies', right_class => 'Station', right_method => 'station', right_method_plural => 'stations', self_method => 'gnarly_stations', }; join_table $config; generate_has_manys $config; generate_many_to_manys $config; 1; Random.pm100644001750001750 672512264533575 23730 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSetpackage DBIx::Class::Helper::ResultSet::Random; use strict; use warnings; use Module::Runtime 'use_module'; use Try::Tiny; # ABSTRACT: Get random rows from a ResultSet our $VERSION = '2.019002'; # VERSION sub _introspector { my $d = use_module('DBIx::Introspector') ->new(drivers => '2013-12.01'); $d->decorate_driver_unconnected(ACCESS => rand_sql => sub { 'RND()' }); $d->decorate_driver_unconnected(Oracle => rand_sql => sub { 'dbms_random.value' }); $d->decorate_driver_unconnected(Pg => rand_sql => sub { 'RANDOM()' }); $d->decorate_driver_unconnected(MSSQL => rand_sql => sub { 'NEWID()' }); $d->decorate_driver_unconnected(SQLite => rand_sql => sub { 'RANDOM()' }); $d } my $d; sub _rand_order_by { my $self = shift; my $storage = $self->result_source->storage; $storage->ensure_connected; $d ||= $self->_introspector; return try { $d->get($storage->dbh, undef, 'rand_sql') } catch { 'RAND()' }; } sub rand { my $self = shift; my $amount = shift || 1; $self->throw_exception('rand can only return a positive amount of rows') unless $amount > 0; $self->throw_exception('rand can only return an integer amount of rows') unless $amount == int $amount; my $order_by = $self->_rand_order_by; return $self->search(undef, { rows=> $amount, order_by => \$order_by}); } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::Random - Get random rows from a ResultSet =head1 VERSION version 2.019002 =head1 SYNOPSIS # note that this is normally a component for a ResultSet package MySchema::ResultSet::Bar; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components('Helper::ResultSet::Random'); # in code using resultset: my $random_row = $schema->resultset('Bar')->rand->single; =head1 DESCRIPTION This component allows convenient selection of random rows. See L for a nice way to apply it to your entire schema. Currently this works by doing something akin to SELECT TOP($x) from $table ORDER BY RANDOM() Lots of people think this is slow. My own benchmarks show that doing the above, for 10 rows in a table with just over 8 million rows, is nearly instant. Although that was with SQL Server, and different databases will handle that differently. So please, if you have performance issues and want this to work with your database, get in touch and I will do what I can to get it to work quickly enough to suite your needs. =head1 METHODS =head2 rand This method takes a single argument, being the size of the random ResultSet to return. It defaults to 1. This Component will throw exceptions if the argument is not an integer or not greater than zero. =head2 _rand_order_by This module currently does an C on some db specific function. If for some reason it guesses incorrectly for your database the easiest way to fix that in the short-term (ie without patching upstream) is to override this method. So for example, if your db uses C instead of C and it's not in the predefined list of dbs you could just do the following in your ResultSet class: sub _rand_order_by { 'RAND()' } =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut StorageValues.pm100644001750001750 740312264533575 24103 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/Rowpackage DBIx::Class::Helper::Row::StorageValues; use strict; use warnings; # ABSTRACT: Keep track of stored vs in-memory row values our $VERSION = '2.019002'; # VERSION use parent 'DBIx::Class'; __PACKAGE__->mk_group_accessors(inherited => '_storage_value_columns'); __PACKAGE__->mk_group_accessors(inherited => '_storage_values'); sub _has_storage_value { $_[0]->column_info($_[1])->{keep_storage_value} } sub storage_value_columns { my $self = shift; if (!$self->_storage_value_columns) { $self->_storage_value_columns([ grep $self->_has_storage_value($_), $self->result_source->columns ]); } return $self->_storage_value_columns; } sub store_storage_values { my $self = shift; $self->_storage_values({ map { my $acc = ($self->column_info($_)->{accessor} || $_); $_ => $self->$acc } @{$self->storage_value_columns} }); $self->_storage_values; } sub get_storage_value { $_[0]->_storage_values->{$_[1]} } sub new { my $class = shift; my $ret = $class->next::method(@_); $ret->store_storage_values; $ret; } sub inflate_result { my $class = shift; my $ret = $class->next::method(@_); $ret->store_storage_values; $ret; } sub insert { my $self = shift; my $ret = $self->next::method(@_); $ret->store_storage_values; $ret; } sub update { my $self = shift; my $ret = $self->next::method(@_); $ret->store_storage_values; $ret; } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::Row::StorageValues - Keep track of stored vs in-memory row values =head1 VERSION version 2.019002 =head1 SYNOPSIS package MyApp::Schema::Result::BlogPost; use parent 'DBIx::Class::Core'; __PACKAGE__->load_components(qw(Helper::Row::StorageValues)); __PACKAGE__->table('BlogPost'); __PACKAGE__->add_columns( id => { data_type => 'integer', is_auto_increment => 1, }, title => { data_type => 'varchar', length => 32, keep_storage_value => 1, }, body => { data_type => 'text', }, ); 1; # elsewhere: my $post = $blog_rs->create({ title => 'Components for fun and profit', body => '...', }); $post->title('Components for fun'); warn sprintf 'Changing title from %s to %s', $post->storage_value('title'), $post->title; $post->update; =head1 DESCRIPTION This component keeps track of the value for a given column in the database. If you change the column's value and do not call C, the C will be different; once C is called the C will be set to the value of the accessor. Note that the fact that it uses the accessor is an important distinction. If you are using L or L it will get the non-storage or inflated values, respectively. =head1 METHODS =head2 _has_storage_value $self->_has_storage_value('colname') returns true if we should store the storage value from the database. Override this if you'd like to enable storage on all integers or something like that: sub _has_storage_value { my ( $self, $column ) = @_; my $info = $self->column_info($column); return defined $info->{data_type} && $info->{data_type} eq 'integer'; } =head2 storage_value_columns $self->storage_value_columns returns a list of columns to store =head2 get_storage_value $self->get_storage_value('colname') returns the value for that column which is in storage =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut SelfResultSet.pm100644001750001750 277612264533575 24073 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/Rowpackage DBIx::Class::Helper::Row::SelfResultSet; use strict; use warnings; # ABSTRACT: Easily use ResultSet methods for the current row our $VERSION = '2.019002'; # VERSION sub self_rs { my ($self) = @_; my $src = $self->result_source; my $rs = $src->resultset; my $me = $rs->current_source_alias; return $rs->search({ # perl, sometimes I hate your guts map +( "$me.$_" => $self->get_column($_) ), $src->primary_columns }) } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::Row::SelfResultSet - Easily use ResultSet methods for the current row =head1 VERSION version 2.019002 =head1 SYNOPSIS In result class: __PACKAGE__->load_components('Helper::Row::SelfResultSet'); Elsewhere: $row->self_rs->$some_rs_method->single =head1 DESCRIPTION Sometimes you need to be able to access a ResultSet containing just the current row. A good reason to do that would be if you had a ResultSet method that adds in some calculated data, like counts of a relationship. You could use this to get at that counted data without duplicating the logic for the counting. =head1 METHODS =head2 self_rs $row->self_rs returns a ResultSet containing B the current row. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut QuoteNames.pm100644001750001750 202412264533575 24023 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/Schemapackage DBIx::Class::Helper::Schema::QuoteNames; # ABSTRACT: force C on use strict; use warnings; our $VERSION = '2.019002'; # VERSION use DBIx::Class::Helpers::Util 'normalize_connect_info'; sub connection { my $self = shift; my $args = normalize_connect_info(@_); $args->{quote_names} = 1; $self->next::method($args) } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::Schema::QuoteNames - force C on =head1 VERSION version 2.019002 =head1 SYNOPSIS package MyApp::Schema; __PACKAGE__->load_components('Helper::Schema::QuoteNames'); =head1 DESCRIPTION This helper merely forces C on, no matter how your settings are configured. You should use it. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut OnColumnChange.pm100644001750001750 2005212264533575 24172 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/Rowpackage DBIx::Class::Helper::Row::OnColumnChange; use strict; use warnings; # ABSTRACT: Do things when the values of a column change our $VERSION = '2.019002'; # VERSION use parent 'DBIx::Class::Helper::Row::StorageValues'; use List::Util 'first'; use DBIx::Class::Candy::Exports; use namespace::clean; export_methods [qw(before_column_change around_column_change after_column_change)]; __PACKAGE__->mk_group_accessors(inherited => $_) for qw(_before_change _around_change _after_change); sub before_column_change { die 'Invalid number of arguments. One $column => $args pair at a time.' unless @_ == 3; my $self = shift; my $column = shift; my $args = shift; die 'method is a required parameter' unless $args->{method}; $args->{column} = $column; $args->{txn_wrap} = !!$args->{txn_wrap}; $self->_before_change([]) unless $self->_before_change; push @{$self->_before_change}, $args; } sub around_column_change { die 'Invalid number of arguments. One $column => $args pair at a time.' unless @_ == 3; my $self = shift; my $column = shift; my $args = shift; die 'no method passed!' unless $args->{method}; $args->{column} = $column; $args->{txn_wrap} = !!$args->{txn_wrap}; $self->_around_change([]) unless $self->_around_change; push @{$self->_around_change}, $args; } sub after_column_change { die 'Invalid number of arguments. One $column => $args pair at a time.' unless @_ == 3; my $self = shift; my $column = shift; my $args = shift; die 'no method passed!' unless $args->{method}; $args->{column} = $column; $args->{txn_wrap} = !!$args->{txn_wrap}; $self->_after_change([]) unless $self->_after_change; unshift @{$self->_after_change}, $args; } sub update { my ($self, $args) = @_; $self->set_inflated_columns($args) if $args; my %dirty = $self->get_dirty_columns or return $self; my @all_before = @{$self->_before_change || []}; my @all_around = @{$self->_around_change || []}; my @all_after = @{$self->_after_change || []}; # prepare functions my @before = grep { defined $dirty{$_->{column}} } @all_before; my @around = grep { defined $dirty{$_->{column}} } @all_around; my @after = grep { defined $dirty{$_->{column}} } @all_after; my $inner = $self->next::can; my $final = sub { $self->$inner($args) }; for ( reverse @around ) { my $fn = $_->{method}; my $old = $self->get_storage_value($_->{column}); my $new = $dirty{$_->{column}}; my $old_final = $final; $final = sub { $self->$fn($old_final, $old, $new) }; } # do we wrap it in a transaction? my $txn_wrap = first { defined $dirty{$_->{column}} && $_->{txn_wrap} } @all_before, @all_around, @all_after; my $guard; $guard = $self->result_source->schema->txn_scope_guard if $txn_wrap; for (@before) { my $fn = $_->{method}; my $old = $self->get_storage_value($_->{column}); my $new = $dirty{$_->{column}}; $self->$fn($old, $new); } my $ret = $final->(); for (@after) { my $fn = $_->{method}; my $old = $self->get_storage_value($_->{column}); my $new = $dirty{$_->{column}}; $self->$fn($old, $new); } $guard->commit if $txn_wrap; $ret } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::Row::OnColumnChange - Do things when the values of a column change =head1 VERSION version 2.019002 =head1 SYNOPSIS package MyApp::Schema::Result::Account; use parent 'DBIx::Class::Core'; __PACKAGE__->load_components(qw(Helper::Row::OnColumnChange)); __PACKAGE__->table('Account'); __PACKAGE__->add_columns( id => { data_type => 'integer', is_auto_increment => 1, }, amount => { data_type => 'float', keep_storage_value => 1, }, ); __PACKAGE__->before_column_change( amount => { method => 'bank_transfer', txn_wrap => 1, } ); sub bank_transfer { my ($self, $old_value, $new_value) = @_; my $delta = abs($old_value - $new_value); if ($old_value < $new_value) { Bank->subtract($delta) } else { Bank->add($delta) } } 1; or with L: package MyApp::Schema::Result::Account; use DBIx::Class::Candy -components => ['Helper::Row::OnColumnChange']; table 'Account'; column id => { data_type => 'integer', is_auto_increment => 1, }; column amount => { data_type => 'float', keep_storage_value => 1, }; before_column_change amount => { method => 'bank_transfer', txn_wrap => 1, }; sub bank_transfer { my ($self, $old_value, $new_value) = @_; my $delta = abs($old_value - $new_value); if ($old_value < $new_value) { Bank->subtract($delta) } else { Bank->add($delta) } } 1; =head1 DESCRIPTION This module codifies a pattern that I've used in a number of projects, namely that of doing B when a column changes it's value in the database. It leverages L for passing in the C<$old_value>, which do not have to use. If you leave the C out of the column definition it will just pass C in as the $old_value. Also note the C option. This allows you to specify that you want the call to C and the call to the method you requested to be wrapped in a transaction. If you end up calling more than one method due to multple column change methods and more than one specify C it will still only wrap once. I've gone to great lengths to ensure that order is preserved, so C and C changes are called in order of definition and C changes are called in reverse order. To be clear, the change methods only get called if the value will be changed after C runs. It correctly looks at the current value of the column as well as the arguments passed to C. =head1 METHODS =head2 before_column_change __PACKAGE__->before_column_change( col_name => { method => 'method', # <-- anything that can be called as a method txn_wrap => 1, # <-- true if you want it to be wrapped in a txn } ); Note: the arguments passed to C will be C<< $self, $old_value, $new_value >>. =head2 after_column_change __PACKAGE__->after_column_change( col_name => { method => 'method', # <-- anything that can be called as a method txn_wrap => 1, # <-- true if you want it to be wrapped in a txn } ); Note: the arguments passed to C will be C<< $self, $old_value, $new_value >>. =head2 around_column_change __PACKAGE__->around_column_change( col_name => { method => 'method', # <-- anything that can be called as a method txn_wrap => 1, # <-- true if you want it to be wrapped in a txn } ); Note: the arguments passed to C will be C<< $self, $next, $old_value, $new_value >>. Around is subtly different than the other two callbacks. You B call C<$next> in your method or it will not work at all. A silly example of how this is done could be: sub around_change_name { my ($self, $next, $old, $new) = @_; my $govt_records = $self->govt_records; $next->(); $govt_records->update({ name => $new }); } Note: the above code implies a weird database schema. I haven't actually seen a time when I've needed around yet, but it seems like there is a use-case. Also Note: you don't get to change the args to C<$next>. If you think you should be able to, you probably don't understand what this component is for. That or you know something I don't (equally likely.) =head1 CANDY EXPORTS If used in conjunction with L this component will export: =over =item before_column_change =item around_column_change =item after_column_change =back =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut CleanResultSet.pm100644001750001750 201412264533575 24205 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/Rowpackage DBIx::Class::Helper::Row::CleanResultSet; use strict; use warnings; # ABSTRACT: Shortcut for C<< ->resultset >> our $VERSION = '2.019002'; # VERSION sub clean_rs { return shift->result_source->resultset } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::Row::CleanResultSet - Shortcut for C<< ->resultset >> =head1 VERSION version 2.019002 =head1 SYNOPSIS In result class: __PACKAGE__->load_components('Helper::Row::CleanResultSet'); Elsewhere: $row->clean_rs->$some_rs_method similar to: $row->result_source->resultset->$some_rs_method =head1 DESCRIPTION Sometimes you need to be able to access the ResultSet containing all rows. =head1 METHODS =head2 clean_rs $row->clean_rs =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut SearchOr.pm100644001750001750 740512264533575 24212 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSetpackage DBIx::Class::Helper::ResultSet::SearchOr; # ABSTRACT: Combine ResultSet searches with OR's use strict; use warnings; our $VERSION = '2.019002'; # VERSION use List::Util 'first'; use Carp::Clan; use namespace::clean; sub search_or { my $self = shift; my @others = @{shift @_ }; croak 'All ResultSets passed to search_or must have the same result_source ' . 'as the invocant!' if first { $self->result_source != $_->result_source } @others; $self->search({ -or => [ map $_->_resolved_attrs->{where}, @others ], }); } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::SearchOr - Combine ResultSet searches with OR's =head1 VERSION version 2.019002 =head1 SYNOPSIS package MyApp::Schema::ResultSet::Tests; use base 'DBIx::Class::ResultSet'; __PACKAGE__->load_components(qw(Helper::ResultSet::IgnoreWantarray Helper::ResultSet::SearchOr)); sub failed { my $self = shift; my $me = $self->current_source_alias; $self->search({ "$me.passed" => '0' }); } sub untested { my $self = shift; my $me = $self->current_source_alias; $self->search({ "$me.passed" => undef }); } sub not_passed { my $self = shift; my $me = $self->current_source_alias; $self->search_or([$self->failed, $self->untested]); } 1; =head1 DESCRIPTION I would argue that the most important feature of L is the fact that you can "chain" ResultSet searches. Unfortunately this can cause problems when you need to reuse multiple ResultSet methods as... well as or's. In the past I got around this by doing: $rs->foo->union([ $rs->bar]); While this works, it can generate some hairy SQL pretty fast. This Helper is supposed to basically be a lightweight union. Note that it therefor has a number of L. The thing that makes this module special is that the ResultSet that is doing the "search_or" ing still limits everything correctly. To be clear, the following only returns C<$user>'s friends that match either of the following criteria: my $friend_rs = $schema->resultset('Friend'); my @internet_friends = $user->friends->search_or([ $friend_rs->on_facebook, $friend_rs->on_twitter, ])->all; With a union, you'd have to implement it like this: $user->friends->on_facebook->union([ $user->friends->on_twitter ]); The union will work, but it will generate more complex SQL that may have lower performance on your database. See L for a nice way to apply it to your entire schema. =head1 METHODS =head2 search_or my $new_rs = $rs->search_or([ $rs->foo, $rs->bar ]); C takes a single arrayref of ResultSets. The ResultSets B point to the same source or you will get an error message. Additionally, no check is made to ensure that more than one ResultSet is in the ArrayRef, but only passing one ResultSet would not make any sense. =head1 LIMITATIONS Because this module us basically an expression union and not a true union, C's won't Just Work. If you have a ResultSet method that uses a C and you want to C it with another method, you'll need to do something like this: my @authors = $authors->search(undef, { join => 'books' })->search_or([ $authors->wrote_good_books, $authors->wrote_bestselling_books, ])->all; Furthermore, if you want to C two methods that C in the same relationship via alternate paths you B use L. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Shortcut.pm100644001750001750 1143612264533575 24336 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSetpackage DBIx::Class::Helper::ResultSet::Shortcut; # ABSTRACT: Shortcuts to common searches (->order_by, etc) use strict; use warnings; our $VERSION = '2.019002'; # VERSION use base (qw( DBIx::Class::Helper::ResultSet::Shortcut::AddColumns DBIx::Class::Helper::ResultSet::Shortcut::Columns DBIx::Class::Helper::ResultSet::Shortcut::Distinct DBIx::Class::Helper::ResultSet::Shortcut::GroupBy DBIx::Class::Helper::ResultSet::Shortcut::HasRows DBIx::Class::Helper::ResultSet::Shortcut::HRI DBIx::Class::Helper::ResultSet::Shortcut::Limit DBIx::Class::Helper::ResultSet::Shortcut::OrderByMagic DBIx::Class::Helper::ResultSet::Shortcut::Prefetch DBIx::Class::Helper::ResultSet::Shortcut::Rows )); 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut - Shortcuts to common searches (->order_by, etc) =head1 VERSION version 2.019002 =head1 SYNOPSIS package MyApp::Schema::ResultSet::Foo; __PACKAGE__->load_components(qw{Helper::ResultSet::Shortcut}); ... 1; And then elsewhere: # let's say you grab a resultset from somewhere else my $foo_rs = get_common_rs() # but I'd like it sorted! ->order_by({ -desc => 'power_level' }) # and without those other dumb columns ->columns([qw/cromulence_ratio has_jimmies_rustled/]) # but get rid of those duplicates ->distinct # and put those straight into hashrefs, please ->hri # but only give me the first 3 ->rows(3); =head1 DESCRIPTION This helper provides convenience methods for resultset modifications. See L for a nice way to apply it to your entire schema. =head1 METHODS =head2 distinct $foo_rs->distinct # equivalent to... $foo_rs->search(undef, { distinct => 1 }); =head2 group_by $foo_rs->group_by([ qw/ some column names /]) # equivalent to... $foo_rs->search(undef, { group_by => [ qw/ some column names /] }); =head2 order_by $foo_rs->order_by({ -desc => 'col1' }); # equivalent to... $foo_rs->search(undef, { order_by => { -desc => 'col1' } }); You can also specify the order as a "magic string", e.g.: $foo_rs->order_by('!col1') # ->order_by({ -desc => 'col1' }) $foo_rs->order_by('col1,col2') # ->order_by([qw(col1 col2)]) $foo_rs->order_by('col1,!col2') # ->order_by([{ -asc => 'col1' }, { -desc => 'col2' }]) $foo_rs->order_by(qw(col1 col2)) # ->order_by([qw(col1 col2)]) Can mix it all up as well: $foo_rs->order_by(qw(col1 col2 col3), 'col4,!col5') =head2 hri $foo_rs->hri; # equivalent to... $foo_rs->search(undef, { result_class => 'DBIx::Class::ResultClass::HashRefInflator' }); =head2 rows $foo_rs->rows(10); # equivalent to... $foo_rs->search(undef, { rows => 10 }) =head2 limit This is an alias for C. $foo_rs->limit(10); # equivalent to... $foo_rs->rows(10); =head2 has_rows A lighter way to check the resultset contains any data rather than calling C<< $rs->count >>. =head2 columns $foo_rs->columns([qw/ some column names /]); # equivalent to... $foo_rs->search(undef, { columns => [qw/ some column names /] }); =head2 add_columns $foo_rs->add_columns([qw/ some column names /]); # equivalent to... $foo_rs->search(undef, { '+columns' => [qw/ some column names /] }); =head2 prefetch $foo_rs->prefetch('bar'); # equivalent to... $foo_rs->search(undef, { prefetch => 'bar' }); =head1 SEE ALSO This component is actually a number of other components put together. It will get more components added to it over time. If you are worried about all the extra methods you won't use or something, using the individual shortcuts is a simple solution. All the documentation will remain here, but the individual components are: =over 2 =item * L =item * L =item * L (adds the "magic string" functionality to C)) =item * L =item * L =item * L =item * L (inherits from C) =item * L (inherits from C) =item * L =item * L =back =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut NoColumns.pm100644001750001750 251612264533575 24417 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSetpackage DBIx::Class::Helper::ResultSet::NoColumns; # ABSTRACT: Look ma, no columns! use strict; use warnings; our $VERSION = '2.019002'; # VERSION sub no_columns { $_[0]->search(undef, { columns => [] }) } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::NoColumns - Look ma, no columns! =head1 VERSION version 2.019002 =head1 SYNOPSIS package MySchema::ResultSet::Bar; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components('Helper::ResultSet::NoColumns'); # in code using resultset: my $rs = $schema->resultset('Bar')->no_columns->search(undef, { '+columns' => { 'foo' => 'me.foo' }, }); =head1 DESCRIPTION This component simply gives you a method to clear the set of columns to be selected. It's just handy sugar. See L for a nice way to apply this to your entire schema. =head1 METHODS =head2 no_columns $rs->no_columns Returns resultset with zero columns configured, fresh for the addition of new columns. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut LintContents.pm100644001750001750 1476312264533575 24423 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/Schemapackage DBIx::Class::Helper::Schema::LintContents; use strict; use warnings; use Scalar::Util 'blessed'; # ABSTRACT: Check the data in your database match your constraints our $VERSION = '2.019002'; # VERSION sub null_check_source { my ($self, $source_name, $non_nullable_columns) = @_; return $self->resultset($source_name)->search({ -or => [ map +{ $_ => undef }, @$non_nullable_columns, ], }) } sub null_check_source_auto { my ($self, $source_name) = @_; my %ci = %{ $self->source($source_name)->columns_info }; $self->null_check_source($source_name, [grep { !$ci{$_}->{is_nullable} } keys %ci]); } sub dup_check_source { my ($self, $source, $unique_columns) = @_; $self->resultset($source)->search(undef, { columns => $unique_columns, group_by => $unique_columns, having => \'count(*) > 1', }) } sub dup_check_source_auto { my ($self, $source) = @_; my %uc = $self->source($source)->unique_constraints; return { map { $_ => scalar $self->dup_check_source($source, $uc{$_}) } keys %uc } } sub _fk_cond_fixer { my ($self, $cond) = @_; return { map { my $k = $_; my $v = $cond->{$_}; $_ =~ s/^(self|foreign)\.// for $k, $v; ($v => $k) } keys %$cond } } sub fk_check_source_auto { my ($self, $from_moniker) = @_; my $from_source = $self->source($from_moniker); my %rels = map { $_ => $from_source->relationship_info($_) } $from_source->relationships; return { map { $_ => scalar $self->fk_check_source( $from_moniker, $from_source->related_source($_), $self->_fk_cond_fixer($rels{$_}->{cond}) ) } grep { my %r = %{$rels{$_}}; ref $r{cond} eq 'HASH' && ($r{attrs}{is_foreign_rel} || $r{attrs}{is_foreign_key_constraint}) } keys %rels } } sub fk_check_source { my ($self, $source_from, $source_to, $columns) = @_; my $to_rs = blessed $source_to ? $source_to->resultset : $self->resultset($source_to) ; my $me = $self->resultset($source_from)->current_source_alias; $self->resultset($source_from)->search({ -not_exists => $to_rs ->search({ map +( "self.$_" => { -ident => "other.$columns->{$_}" } ), keys %$columns }, { alias => 'other', })->as_query, }, { alias => 'self', }) } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::Schema::LintContents - Check the data in your database match your constraints =head1 VERSION version 2.019002 =head1 SYNOPSIS package MyApp::Schema; use parent 'DBIx::Class::Schema'; __PACKAGE__->load_components('Helper::Schema::LintContents'); 1; And later, somewhere else: say "Incorrectly Null Users:"; for ($schema->null_check_source_auto('User')->all) { say '* ' . $_->id } say "Duplicate Users:"; my $duplicates = $schema->dup_check_source_auto('User'); for (keys %$duplicates) { say "Constraint: $_"; for ($duplicates->{$_}->all) { say '* ' . $_->id } } say "Users with invalid FK's:"; my $invalid_fks = $schema->fk_check_source_auto('User'); for (keys %$invalid_fks) { say "Rel: $_"; for ($invalid_fks->{$_}->all) { say '* ' . $_->id } } =head1 DESCRIPTION Some people think that constraints make their databases slower. As silly as that is, I have been in a similar situation! I'm here to help you, dear developers! Basically this is a suite of methods that allow you to find violated "constraints." To be clear, the constraints I mean are the ones you tell L about, real constraints are fairly sure to be followed. =head1 METHODS =head2 fk_check_source my $busted = $schema->fk_check_source( 'User', 'Group', { group_id => 'id' }, ); C takes three arguments, the first is the B source moniker of a relationship. The second is the B source or source moniker of a relationship. The final argument is a hash reference representing the columns of the relationship. The return value is a resultset of the B source that do not have a corresponding B row. To be clear, the example given above would return a resultset of C rows that have a C that points to a C that does not exist. =head2 fk_check_source_auto my $broken = $schema->fk_check_source_auto('User'); C takes a single argument: the source to check. It will check all the foreign key (that is, C) relationships for missing... C rows. The return value will be a hashref where the keys are the relationship name and the values are resultsets of the respective violated relationship. =head2 dup_check_source my $smashed = $schema->fk_check_source( 'Group', ['id'] ); C takes two arguments, the first is the source moniker to be checked. The second is an arrayref of columns that "should be" unique. The return value is a resultset of the source that duplicate the passed columns. So with the example above the resultset would return all groups that are "duplicates" of other groups based on C. =head2 dup_check_source_auto my $ruined = $schema->dup_check_source_auto('Group'); C takes a single argument, which is the name of the resultsource in which to check for duplicates. It will return a hashref where they keys are the names of the unique constraints to be checked. The values will be resultsets of the respective duplicate rows. =head2 null_check_source my $blarg = $schema->null_check_source('Group', ['id']); C tales two arguments, the first is the name of the source to check. The second is an arrayref of columns that should contain no nulls. The return value is simply a resultset of rows that contain nulls where they shouldn't be. =head2 null_check_source_auto my $wrecked = $schema->null_check_source_auto('Group'); C takes a single argument, which is the name of the resultsource in which to check for nulls. The return value is simply a resultset of rows that contain nulls where they shouldn't be. This method automatically uses the configured columns that have C set to false. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut RelationshipDWIM.pm100644001750001750 364712264533575 24447 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/Rowpackage DBIx::Class::Helper::Row::RelationshipDWIM; use strict; use warnings; # ABSTRACT: Type less for your relationships! our $VERSION = '2.019002'; # VERSION sub default_result_namespace { die 'you forgot to set your default_result_namespace' } sub belongs_to { my ( $self, @args ) = @_; $args[1] =~ s/^::/$self->default_result_namespace . '::'/e; $self->next::method(@args); } sub has_many { my ( $self, @args ) = @_; $args[1] =~ s/^::/$self->default_result_namespace . '::'/e; $self->next::method(@args); } sub might_have { my ( $self, @args ) = @_; $args[1] =~ s/^::/$self->default_result_namespace . '::'/e; $self->next::method(@args); } sub has_one { my ( $self, @args ) = @_; $args[1] =~ s/^::/$self->default_result_namespace . '::'/e; $self->next::method(@args); } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::Row::RelationshipDWIM - Type less for your relationships! =head1 VERSION version 2.019002 =head1 SYNOPSIS Base clase: package MyApp::Schema::Result; use parent 'DBIx::Class::Core'; __PACKAGE__->load_components('Helper::Row::RelationshipDWIM'); sub default_result_namespace { 'MyApp::Schema::Result' } 1; Result class: package MyApp::Schema::Result::Foo; use parent 'MyApp::Schema::Result'; # Define various class bits here # succint relationship definition yeah! __PACKAGE__->has_many(friends => '::Person', 'foo_id'); # or with DBIx::Class::Candy: has_many friends => '::Person', 'foo_id'; 1; =head1 DESCRIPTION This module prepends your C to related objects if they begin with C<::>. Simple but handy. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut VirtualView.pm100644001750001750 623612264533575 24766 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSetpackage DBIx::Class::Helper::ResultSet::VirtualView; use strict; use warnings; # ABSTRACT: Clean up your SQL namespace (DEPRECATED) our $VERSION = '2.019002'; # VERSION sub as_virtual_view { my $self = shift; return $self->as_subselect_rs; } use Carp::Clan; carp 'This module is deprecated! Please use DBIx::Class::ResultSet::as_subselect_rs instead!' if $VERSION >= 3; croak 'This module is deprecated! Please use DBIx::Class::ResultSet::as_subselect_rs instead!' if $VERSION >= 4; 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::VirtualView - Clean up your SQL namespace (DEPRECATED) =head1 VERSION version 2.019002 =head1 SYNOPSIS # note that this is normally a component for a ResultSet package MySchema::ResultSet::Bar; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components('Helper::ResultSet::VirtualView'); # and then in code that uses the ResultSet Join with relation x my $rs = $schema->resultset('Bar')->search({'x.name' => 'abc'},{ join => 'x' }); # 'x' now pollutes the query namespace # So the following works as expected my $ok_rs = $rs->search({'x.other' => 1}); # But this doesn't: instead of finding a 'Bar' related to two x rows (abc and # def) we look for one row with contradictory terms and join in another table # (aliased 'x_2') which we never use my $broken_rs = $rs->search({'x.name' => 'def'}); my $rs2 = $rs->as_virtual_view; # doesn't work - 'x' is no longer accessible in $rs2, having been sealed away my $not_joined_rs = $rs2->search({'x.other' => 1}); # works as expected: finds a 'table' row related to two x rows (abc and def) my $correctly_joined_rs = $rs2->search({'x.name' => 'def'}); =head1 DESCRIPTION This component is will allow you to clean up your SQL namespace. See L for a nice way to apply it to your entire schema. =head1 DEPRECATED This component has been suplanted by L. In the next major version (3) we will begin issuing a warning on it's use. In the major version after that (4) we will remove it entirely. =head1 METHODS =head2 as_virtual_view Act as a barrier to SQL symbols. The resultset provided will be made into a "virtual view" by including it as a subquery within the from clause. From this point on, any joined tables are inaccessible to ->search on the resultset (as if it were simply where-filtered without joins). See L for example. =head1 NOTE You don't I to use this as a Component. If you prefer you can use it in the following manner: # in code using ResultSet: use DBIx::Class:Helper::VirtualView; my $new_rs = DBIx::Class::Helper::VirtualView::as_virtual_view($rs); =head1 THANKS Thanks to ijw from #dbix-class for the idea for this helper (originally called seal), most of the code, and most of the documentation. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut GenerateSource.pm100644001750001750 436612264533575 24670 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/Schemapackage DBIx::Class::Helper::Schema::GenerateSource; # ABSTRACT: Generate sources directly from your Schema use strict; use warnings; our $VERSION = '2.019002'; # VERSION use Scalar::Util 'blessed'; sub _schema_class { blessed($_[0]) || $_[0] } sub _generate_class_name { $_[0]->_schema_class . '::GeneratedResult::__' . uc $_[1] } sub _generate_class { die $@ unless eval " package $_[1]; use parent '$_[2]'; __PACKAGE__->table(__PACKAGE__->table); 1; "; } sub generate_source { my ($self, $moniker, $base) = @_; my $class = $self->_generate_class_name($moniker); $self->_generate_class($class, $base); $self->register_class($moniker, $class); } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::Schema::GenerateSource - Generate sources directly from your Schema =head1 VERSION version 2.019002 =head1 SYNOPSIS package MyApp::Schema; __PACKAGE__->load_components('Helper::Schema::GenerateSource'); __PACKAGE__->generate_source(User => 'MyCompany::BaseResult::User'); =head1 DESCRIPTION This helper allows you to handily and correctly add new result sources to your schema based on existing result sources. Typically this would be done with something like: package MyApp::Schema::Result::MessegeQueue; use parent 'MyCo::Schema::Result::MessageQueue'; __PACKAGE__->table(__PACKAGE__->table); 1; which clearly is in its own file. This should still be done when you need to add columns or really do B other than just basic addition of the result source to your schema. B: This component correctly generates an "anonymous" subclass of the given base class. Do not depend on the name of the subclass as it is currently considered unstable. =head1 METHODS =head2 generate_source $schema->generate_source(User => 'MyCompany::BaseResult::User') The first argument to C is the C to register the class as, the second argument is the base class for the new result source. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Shortcut000755001750001750 012264533575 23613 5ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSetHRI.pm100644001750001750 123112264533575 24730 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSet/Shortcutpackage DBIx::Class::Helper::ResultSet::Shortcut::HRI; use strict; use warnings; our $VERSION = '2.019002'; # VERSION sub hri { shift->search(undef, { result_class => 'DBIx::Class::ResultClass::HashRefInflator' }) } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::HRI =head1 VERSION version 2.019002 =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut SetOperations.pm100644001750001750 1142312264533575 25316 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSetpackage DBIx::Class::Helper::ResultSet::SetOperations; use strict; use warnings; # ABSTRACT: Do set operations with DBIx::Class our $VERSION = '2.019002'; # VERSION # cribbed from perlfaq4 sub _compare_arrays { my ($self, $first, $second) = @_; no warnings; # silence spurious -w undef complaints return 0 unless @$first == @$second; for (my $i = 0; $i < @$first; $i++) { return 0 if $first->[$i] ne $second->[$i]; } return 1; } sub union { shift->_set_operation( UNION => @_ ); } sub union_all { shift->_set_operation( "UNION ALL" => @_ ); } sub intersect { shift->_set_operation( INTERSECT => @_ ); } sub intersect_all { shift->_set_operation( "INTERSECT ALL" => @_ ); } sub _except_keyword { my $self = shift; $self->{_except_keyword} ||= ( $self->result_source->schema->storage->sqlt_type eq 'Oracle' ? "MINUS" : "EXCEPT" ); } sub except { my ( $self, @args ) = @_; $self->_set_operation( $self->_except_keyword => @args ); } sub except_all { # not supported on most DBs shift->_set_operation( "EXCEPT ALL" => @_ ); } sub _set_operation { my ( $self, $operation, $other ) = @_; my @sql; my @params; my $as = $self->_resolved_attrs->{as}; my @operands = ( $self, ref $other eq 'ARRAY' ? @$other : $other ); for (@operands) { $self->throw_exception("ResultClass of ResultSets do not match!") unless $self->result_class eq $_->result_class; my $attrs = $_->_resolved_attrs; $self->throw_exception('ResultSets do not all have the same selected columns!') unless $self->_compare_arrays($as, $attrs->{as}); my ($sql, @bind) = @{${$_->as_query}}; $sql =~ s/^\s*\((.*)\)\s*$/$1/; push @sql, $sql; push @params, @bind; } my $query = q<(> . join(" $operation ", @sql). q<)>; my $attrs = $self->_resolved_attrs; return $self->result_source->resultset->search(undef, { alias => $self->current_source_alias, from => [{ $self->current_source_alias => \[ $query, @params ], -alias => $self->current_source_alias, -source_handle => $self->result_source->handle, }], columns => $attrs->{as}, result_class => $self->result_class, }); } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::SetOperations - Do set operations with DBIx::Class =head1 VERSION version 2.019002 =head1 SYNOPSIS package MyApp::Schema::ResultSet::Foo; __PACKAGE__->load_components(qw{Helper::ResultSet::SetOperations}); ... 1; And then elsewhere, like in a controller: my $rs1 = $rs->search({ foo => 'bar' }); my $rs2 = $rs->search({ baz => 'biff' }); for ($rs1->union($rs2)->all) { ... } =head1 DESCRIPTION This component allows you to use various set operations with your ResultSets. See L for a nice way to apply it to your entire schema. Component throws exceptions if ResultSets have different ResultClasses or different "Columns Specs." The basic idea here is that in SQL if you use a set operation they must be selecting the same columns names, so that the results will all match. The deal with the ResultClasses is that DBIC needs to inflate the results the same for the entire ResultSet, so if one were to try to apply something like a union in a table with the same column name but different classes DBIC wouldn't be doing what you would expect. A nice way to use this is with L. You might have something like the following sketch autocompletion code: my $rs1 = $schema->resultset('Album')->search({ name => { -like => "$input%" } }, { columns => [qw( id name ), { tablename => \['?', [{} => 'album']], }], }); my $rs2 = $schema->resultset('Artist')->search({ name => { -like => "$input%" } }, { columns => [qw( id name ), { tablename => \['?', [{} => 'artist']], }], }); my $rs3 = $schema->resultset('Song')->search({ name => { -like => "$input%" } }, { columns => [qw( id name ), { tablename => \['?', [{} => 'song']], }], }); $_->result_class('DBIx::Class::ResultClass::HashRefInflator') for ($rs1, $rs2, $rs3); my $data = [$rs1->union([$rs2, $rs3])->all]; =head1 METHODS =head2 union =head2 union_all =head2 intersect =head2 intersect_all =head2 except =head2 except_all All of these methods take a single ResultSet or an ArrayRef of ResultSets as the parameter only parameter. On Oracle C will issue a C operation. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut RemoveColumns.pm100644001750001750 357312264533575 25304 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSetpackage DBIx::Class::Helper::ResultSet::RemoveColumns; # ABSTRACT: Remove columns from a ResultSet our $VERSION = '2.019002'; # VERSION sub _resolved_attrs { my $self = $_[0]; my $attrs = $self->{attrs}; # not copying on purpose... if ( $attrs->{remove_columns} ) { my %rc = map { $_ => 1 } @{$attrs->{remove_columns}}; $attrs->{columns} = [ grep { !$rc{$_} } $self->result_source->columns ] } return $self->next::method; } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::RemoveColumns - Remove columns from a ResultSet =head1 VERSION version 2.019002 =head1 SYNOPSIS package MySchema::ResultSet::Bar; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components('Helper::ResultSet::RemoveColumns'); # in code using resultset: my $rs = $schema->resultset('Bar')->search(undef, { remove_columns => ['giant_text_col', 'password'], }); =head1 DESCRIPTION This component allows convenient removal of columns from a select. Normally to do this you would do this by listing all of the columns B the ones you want to remove. This does that part for you. See L for a nice way to apply it to your entire schema. It doesn't get a lot more complicated than the synopsis. If you are interested in having more control, check out L. =over =item * Load the component =item * Put an C of columns to remove in the C search attribute. =item * Profit. =back =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Rows.pm100644001750001750 114512264533575 25244 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSet/Shortcutpackage DBIx::Class::Helper::ResultSet::Shortcut::Rows; use strict; use warnings; our $VERSION = '2.019002'; # VERSION sub rows { shift->search(undef, { rows => shift }) } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::Rows =head1 VERSION version 2.019002 =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut ProxyResultSetMethod.pm100644001750001750 730712264533575 25457 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/Rowpackage DBIx::Class::Helper::Row::ProxyResultSetMethod; use strict; use warnings; # ABSTRACT: Efficiently reuse ResultSet methods from results with fallback our $VERSION = '2.019002'; # VERSION use base 'DBIx::Class::Helper::Row::SelfResultSet'; use Sub::Name (); use DBIx::Class::Candy::Exports; export_methods [qw( proxy_resultset_method )]; sub proxy_resultset_method { my ($self, $name, $attr) = @_; my $rs_method = $attr->{resultset_method} || "with_$name"; my $slot = $attr->{slot} || $name; no strict 'refs'; my $method = $self . '::' . $name; *{$method} = Sub::Name::subname $method, sub { use strict 'refs'; # boo. The accessor checks that there's an actual column defined, so we # skip it so we can cache results. $_[0]->{_column_data}{$slot} = $_[0]->self_rs ->search(undef, { columns => [] }) ->$rs_method ->get_column($slot) ->next unless $_[0]->has_column_loaded($slot); return $_[0]->get_column($slot) } } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::Row::ProxyResultSetMethod - Efficiently reuse ResultSet methods from results with fallback =head1 VERSION version 2.019002 =head1 SYNOPSIS ResultSet: package MyApp::Schema::ResultSet::Foo; use base 'DBIx::Class::ResultSet'; __PACKAGE__->load_components(qw( Helper::ResultSet::CorrelateRelationship )); ...; sub with_friend_count { shift->search(undef, { '+columns' => { 'friend_count' => $self->correlate('friends')->count_rs->as_query, }, }) } Result: package MyApp::Schema::Result::Foo; use base 'DBIx::Class::Core'; __PACKAGE__->load_components(qw( Helper::Row::ProxyResultSetMethod )); __PACKAGE__->proxy_resultset_method('friend_count'); or with L: package MyApp::Schema::Result::Foo; use DBIx::Class::Candy -components => ['Helper::Row::ProxyResultSetMethod']; proxy_resultset_method 'friend_count'; Elsewhere: my $row = $foo_rs->first; say $row->friend_count . ' friends'; =head1 DESCRIPTION This module makes reusing resultset methods from a result trivially easy. You should be using it. =head1 METHODS =head2 proxy_resultset_method __PACKAGE__->proxy_resultset_method( $name => { slot => $slot, resultset_method => $rs_method }); C's first argument is the name of the method to generate and is required. The other two arguments, C<$slot>, and C<$resultset_method> are optional. If unspecified C<$slot> will default to C<$name> and C<$resultset_method> will default to C<"with_$name">. C<$slot> is the column that the data being retrieved is stored as in the ResultSet method being proxied to. C<$resultset_method> is (duh) the ResultSet method being proxied to. If you did not call the C method on your ResultSet, and call the proxy method, it will transparently B and do the call and fetch the needed data. E.g.: my $foo = $schema->resultset('Foo')->first; ## did not call with_friend_count print $foo->friend_count; ## will produce desired result magically =head1 CANDY EXPORTS If used in conjunction with L this component will export: =over =item proxy_resultset_method =back =head1 DEDICATION This module is dedicated to Ray Bradbury, who wrote Something Wicked This Way Comes, Dandelion Wine, and numerous short stories, plays, etc etc. Read this author's books. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut ProxyResultSetUpdate.pm100644001750001750 443112264533575 25454 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/Rowpackage DBIx::Class::Helper::Row::ProxyResultSetUpdate; # ABSTRACT: Efficiently reuse ResultSet updates from results our $VERSION = '2.019002'; # VERSION use base 'DBIx::Class::Helper::Row::SelfResultSet'; sub update { my ($self, $upd) = @_; $self->set_inflated_columns($upd) if $upd; my %to_update = $self->get_dirty_columns or return $self; $self->throw_exception( "Not in database" ) unless $self->in_storage; # copied directly from DBIx::Class::Row except for this line my $rows = $self->self_rs->update(\%to_update); if ($rows == 0) { $self->throw_exception( "Can't update ${self}: row not found" ); } elsif ($rows > 1) { $self->throw_exception("Can't update ${self}: updated more than one row"); } $self->{_dirty_columns} = {}; $self->{related_resultsets} = {}; delete $self->{_column_data_in_storage}; return $self; } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::Row::ProxyResultSetUpdate - Efficiently reuse ResultSet updates from results =head1 VERSION version 2.019002 =head1 SYNOPSIS ResultSet: package MyApp::Schema::ResultSet::Foo; use base 'DBIx::Class::ResultSet'; sub update { my ($self, $data) = @_; die 'you fool!' if $data->{name} eq 'fool'; return $self->next::method($data); } Result: package MyApp::Schema::Result::Foo; use base 'DBIx::Class::Core'; __PACKAGE__->load_components(qw( Helper::Row::ProxyResultSetUpdate )); ... or with L: package MyApp::Schema::Result::Foo; use DBIx::Class::Candy -components => ['Helper::Row::ProxyResultSetMethod']; ... =head1 DESCRIPTION This module makes reusing resultset updates from a result trivially easy. Often the only way that people share update methods is by overriding update in their resultset to use L. Unfortunately, that can end up being wildly inefficient. Instead, if you can write your update in terms of the resultset, you can make your code much faster and more efficient. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Limit.pm100644001750001750 122312264533575 25365 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSet/Shortcutpackage DBIx::Class::Helper::ResultSet::Shortcut::Limit; use strict; use warnings; use base 'DBIx::Class::Helper::ResultSet::Shortcut::Rows'; our $VERSION = '2.019002'; # VERSION sub limit { return shift->rows(@_) } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::Limit =head1 VERSION version 2.019002 =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut IgnoreWantarray.pm100644001750001750 243112264533575 25612 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSetpackage DBIx::Class::Helper::ResultSet::IgnoreWantarray; use strict; use warnings; # ABSTRACT: Get rid of search context issues our $VERSION = '2.019002'; # VERSION sub search { shift->search_rs(@_); } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::IgnoreWantarray - Get rid of search context issues =head1 VERSION version 2.019002 =head1 SYNOPSIS package MyApp::Schema::ResultSet::Foo; __PACKAGE__->load_components(qw{Helper::ResultSet::IgnoreWantarray}); ... 1; And then else where, like in a controller: my $rs = $self->paginate( $schema->resultset('Foo')->search({ name => 'frew' }) ); =head1 DESCRIPTION This component makes search always return a ResultSet, instead of returning an array of your database in array context. See L for a nice way to apply it to your entire schema. =head1 METHODS =head2 search Override of the default search method to force it to return a ResultSet. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut ResultClassDWIM.pm100644001750001750 321012264533575 25417 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSetpackage DBIx::Class::Helper::ResultSet::ResultClassDWIM; # ABSTRACT: result_class => '::HRI' == WIN our $VERSION = '2.019002'; # VERSION use strict; use warnings; sub result_class { my ($self, $result_class) = @_; return $self->next::method unless defined $result_class; if (!ref $result_class) { if ($result_class eq '::HRI') { $result_class = 'DBIx::Class::ResultClass::HashRefInflator' } else { $result_class =~ s/^::/DBIx::Class::ResultClass::/; } } $self->next::method($result_class); } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::ResultClassDWIM - result_class => '::HRI' == WIN =head1 VERSION version 2.019002 =head1 SYNOPSIS package MyApp::Schema::ResultSet::Foo; __PACKAGE__->load_components(qw{Helper::ResultSet::ResultClassDWIM}); ... 1; And then elsewhere: my $data = $schema->resultset('Foo')->search({ name => 'frew' }, { result_class => '::HRI' })->all; =head1 DESCRIPTION This component allows you to prefix your C with C<::> to indicate that it should use the default namespace, namely, C. C<::HRI> has been hardcoded to work. Of course C<::HashRefInflator> would also work fine. See L for a nice way to apply it to your entire schema. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Columns.pm100644001750001750 116112264533575 25730 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSet/Shortcutpackage DBIx::Class::Helper::ResultSet::Shortcut::Columns; use strict; use warnings; our $VERSION = '2.019002'; # VERSION sub columns { shift->search(undef, { columns => shift }) } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::Columns =head1 VERSION version 2.019002 =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut OrderBy.pm100644001750001750 116312264533575 25660 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSet/Shortcutpackage DBIx::Class::Helper::ResultSet::Shortcut::OrderBy; use strict; use warnings; our $VERSION = '2.019002'; # VERSION sub order_by { shift->search(undef, { order_by => shift }) } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::OrderBy =head1 VERSION version 2.019002 =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut GroupBy.pm100644001750001750 116312264533575 25701 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSet/Shortcutpackage DBIx::Class::Helper::ResultSet::Shortcut::GroupBy; use strict; use warnings; our $VERSION = '2.019002'; # VERSION sub group_by { shift->search(undef, { group_by => shift }) } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::GroupBy =head1 VERSION version 2.019002 =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HasRows.pm100644001750001750 123312264533575 25676 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSet/Shortcutpackage DBIx::Class::Helper::ResultSet::Shortcut::HasRows; use strict; use warnings; use base 'DBIx::Class::Helper::ResultSet::Shortcut::Rows'; our $VERSION = '2.019002'; # VERSION sub has_rows { !! shift->rows(1)->next } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::HasRows =head1 VERSION version 2.019002 =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut AutoRemoveColumns.pm100644001750001750 657512264533575 26142 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSetpackage DBIx::Class::Helper::ResultSet::AutoRemoveColumns; # ABSTRACT: Automatically remove columns from a ResultSet our $VERSION = '2.019002'; # VERSION use parent 'DBIx::Class::Helper::ResultSet::RemoveColumns', 'DBIx::Class'; __PACKAGE__->mk_group_accessors(inherited => '_fetchable_columns'); my %dont_fetch = ( text => 1, ntext => 1, blob => 1, clob => 1, bytea => 1, ); sub _should_column_fetch { my ( $self, $column ) = @_; my $info = $self->result_source->column_info($column); if (!defined $info->{remove_column}) { if (defined $info->{data_type} && $dont_fetch{lc $info->{data_type}} ) { $info->{remove_column} = 1; } else { $info->{remove_column} = 0; } } return $info->{remove_column}; } sub fetchable_columns { my $self = shift; if (!$self->_fetchable_columns) { $self->_fetchable_columns([ grep $self->_should_column_fetch($_), $self->result_source->columns ]); } return $self->_fetchable_columns; } sub _resolved_attrs { local $_[0]->{attrs}{remove_columns} = $_[0]->{attrs}{remove_columns} || $_[0]->fetchable_columns; return $_[0]->next::method; } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::AutoRemoveColumns - Automatically remove columns from a ResultSet =head1 VERSION version 2.019002 =head1 SYNOPSIS package MySchema::Result::Bar; use strict; use warnings; use parent 'DBIx::Class::Core'; __PACKAGE__->table('KittenRobot'); __PACKAGE__->add_columns( id => { data_type => 'integer', is_auto_increment => 1, }, kitten => { data_type => 'integer', }, robot => { data_type => 'text', is_nullable => 1, }, your_mom => { data_type => 'blob', is_nullable => 1, remove_column => 0, }, ); 1; package MySchema::ResultSet::Bar; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components('Helper::ResultSet::AutoRemoveColumns'); =head1 DESCRIPTION This component automatically removes "heavy-weight" columns. To be specific, columns of type C, C, C, C, or C. You may use the C key in the column info to specify directly whether or not to remove the column automatically. See L for a nice way to apply it to your entire schema. =head1 METHODS =head2 _should_column_fetch $self->_should_column_fetch('kitten') returns true if a column should be fetched or not. This fetches a column if it is not of type C, C, C, C, or C or the C is set to true. If you only wanted to explicitly state which columns to remove you might override this method like this: sub _should_column_fetch { my ( $self, $column ) = @_; my $info = $self->column_info($column); return !defined $info->{remove_column} || $info->{remove_column}; } =head2 fetchable_columns simply returns a list of columns that are fetchable. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Distinct.pm100644001750001750 121112264533575 26065 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSet/Shortcutpackage DBIx::Class::Helper::ResultSet::Shortcut::Distinct; use strict; use warnings; our $VERSION = '2.019002'; # VERSION sub distinct { $_[0]->search(undef, { distinct => defined $_[1] ? $_[1] : 1 }) } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::Distinct =head1 VERSION version 2.019002 =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Prefetch.pm100644001750001750 112612264533575 26051 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSet/Shortcutpackage DBIx::Class::Helper::ResultSet::Shortcut::Prefetch; use strict; use warnings; sub prefetch { return shift->search(undef, { prefetch => shift }) } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::Prefetch =head1 VERSION version 2.019002 =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut AddColumns.pm100644001750001750 117612264533575 26347 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSet/Shortcutpackage DBIx::Class::Helper::ResultSet::Shortcut::AddColumns; use strict; use warnings; our $VERSION = '2.019002'; # VERSION sub add_columns { shift->search(undef, { '+columns' => shift }) } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::AddColumns =head1 VERSION version 2.019002 =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut CorrelateRelationship.pm100644001750001750 1221012264533575 27014 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSetpackage DBIx::Class::Helper::ResultSet::CorrelateRelationship; use strict; use warnings; # ABSTRACT: Easily correlate your ResultSets our $VERSION = '2.019002'; # VERSION sub correlate { my ($self, $rel) = @_; my $source = $self->result_source; my $rel_info = $source->relationship_info($rel); return $source->related_source($rel)->resultset ->search(scalar $source->_resolve_condition( $rel_info->{cond}, "${rel}_alias", $self->current_source_alias, $rel ), { alias => "${rel}_alias", }) } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::CorrelateRelationship - Easily correlate your ResultSets =head1 VERSION version 2.019002 =head1 SYNOPSIS package MyApp::Schema::ResultSet::Author; use base 'DBIx::Class::ResultSet'; __PACKAGE__->load_components(qw(Helper::ResultSet::CorrelateRelationship)); sub with_book_count { my $self = shift; $self->search(undef, { '+columns' => { book_count => $self->correlate('books')->count_rs->as_query } }); } 1; And then elsewhere, like in a controller: my $rows = $schema->resultset('Author')->with_book_count->all; =head1 DESCRIPTION Correlated queries are one of the coolest things I've learned about for SQL since my initial learning of SQL. Unfortunately they are somewhat confusing. L has supported doing them for a long time, but generally people don't think of them because they are so rare. I won't go through all the details of how they work and cool things you can do with them, but here are a couple high level things you can use them for to save you time or effort. If you want to select a list of authors and counts of books for each author, you B use C and something like C, but then you'd need to make your select list match your C and it would just be a hassle forever after that. The L is a perfect example of how to implement this. If you want to select a list of authors and two separate kinds of counts of books for each author, as far as I know, you B use a correlated subquery in L. Here is an example of how you might do that: package MyApp::Schema::ResultSet::Author; use base 'DBIx::Class::ResultSet'; __PACKAGE__->load_components(qw(Helper::ResultSet::CorrelateRelationship)); sub with_good_book_count { my $self = shift; $self->search(undef, { '+columns' => { good_book_count => $self->correlate('books')->good->count_rs->as_query } }); } sub with_bad_book_count { my $self = shift; $self->search(undef, { '+columns' => { bad_book_count => $self->correlate('books')->bad->count_rs->as_query } }); } 1; And then elsewhere, like in a controller: my $rows = $schema->resultset('Author') ->with_bad_book_count ->with_good_book_count ->all; This assumes that the Book resultset has C and C methods. See L for a nice way to apply it to your entire schema. =head1 METHODS =head2 correlate $rs->correlate($relationship_name) Correlate takes a single argument, a relationship for the invocant, and returns a resultset that can be used in the selector list. =head1 EXAMPLES =head2 counting CD's and Tracks of Artists If you had an Artist ResultSet and you wanted to count the tracks and CD's per Artist, here is a recipe that will work: sub with_track_count { my $self = shift; $self->search(undef, { '+columns' => { track_count => $self->correlate('cds') ->related_resultset('tracks') ->count_rs ->as_query } }); } sub with_cd_count { my $self = shift; $self->search(undef, { '+columns' => { cd_count => $self->correlate('cds') ->count_rs ->as_query } }); } # elsewhere my @artists = $artists->with_cd_count->with_track_count->all; Note that the following will B work: sub BUSTED_with_track_count { my $self = shift; $self->search(undef, { '+columns' => { track_count => $self->related_resultset('cds') ->correlate('tracks') ->count_rs ->as_query } }); } The above is broken because C returns a fresh resultset that will only work as a subquery to the ResultSet it was chained off of. The upshot of that is that the above C relationship is on the C ResultSet, whereas the query is for the Artist ResultSet, so the correlation will be "broken" by effectively "joining" to columns that are not in the current scope. For the same reason, the following will also not work: sub BUSTED2_with_track_count { my $self = shift; $self->search(undef, { '+columns' => { track_count => $self->correlate('cds') ->correlate('tracks') ->count_rs ->as_query } }); } =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut OrderByMagic.pm100644001750001750 241512264533575 26622 0ustar00frewfrew000000000000DBIx-Class-Helpers-2.019002/lib/DBIx/Class/Helper/ResultSet/Shortcutpackage DBIx::Class::Helper::ResultSet::Shortcut::OrderByMagic; use strict; use warnings; our $VERSION = '2.019002'; # VERSION use base 'DBIx::Class::Helper::ResultSet::Shortcut::OrderBy'; sub order_by { my ($self, @order) = @_; return $self->next::method(@order) if @order && ref($order[0]); my @clauses; foreach (@order) { foreach my $col (split(/\s*,\s*/)) { my $dir = 'asc'; if (substr($col, 0, 1) eq '!') { $col = substr($col, 1); # take everything after '!' $dir = 'desc'; } # add csa prefix if necessary $col = join('.', $self->current_source_alias, $col) if index($col, '.') == -1; push @clauses, { "-$dir" => $col }; } } return $self->next::method(\@clauses); } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::OrderByMagic =head1 VERSION version 2.019002 =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut