[libdbix-class-deploymenthandler-perl] 01/01: [svn-inject] Installing original source of libdbix-class-deploymenthandler-perl (0.001004)
Damyan Ivanov
dmn at moszumanska.debian.org
Sun Oct 29 18:08:22 UTC 2017
This is an automated email from the git hooks/post-receive script.
dmn pushed a commit to tag upstream/0.001004
in repository libdbix-class-deploymenthandler-perl.
commit 59bf900bd75979e1b6d2e992d205492668e8c410
Author: Jonathan Yu <jawnsy at cpan.org>
Date: Sat Feb 26 15:57:59 2011 +0000
[svn-inject] Installing original source of libdbix-class-deploymenthandler-perl (0.001004)
---
Changes | 86 ++
LICENSE | 377 +++++++++
MANIFEST | 60 ++
META.json | 54 ++
Makefile.PL | 67 ++
README | 150 ++++
dist.ini | 41 +
lib/DBIx/Class/DeploymentHandler.pm | 249 ++++++
.../Cookbook/CustomResultSource.pod | 115 +++
lib/DBIx/Class/DeploymentHandler/Dad.pm | 266 ++++++
.../DeployMethod/SQL/Translator.pm | 933 +++++++++++++++++++++
.../DeployMethod/SQL/Translator/Deprecated.pm | 131 +++
lib/DBIx/Class/DeploymentHandler/Deprecated.pm | 146 ++++
lib/DBIx/Class/DeploymentHandler/HandlesDeploy.pm | 151 ++++
.../DeploymentHandler/HandlesVersionStorage.pm | 93 ++
.../Class/DeploymentHandler/HandlesVersioning.pm | 159 ++++
lib/DBIx/Class/DeploymentHandler/Logger.pm | 64 ++
.../DeploymentHandler/Manual/CatalystIntro.pod | 258 ++++++
lib/DBIx/Class/DeploymentHandler/Manual/Intro.pod | 192 +++++
lib/DBIx/Class/DeploymentHandler/Types.pm | 54 ++
.../VersionHandler/DatabaseToSchemaVersions.pm | 92 ++
.../VersionHandler/ExplicitVersions.pm | 135 +++
.../DeploymentHandler/VersionHandler/Monotonic.pm | 101 +++
.../DeploymentHandler/VersionStorage/Deprecated.pm | 113 +++
.../VersionStorage/Deprecated/Component.pm | 76 ++
.../VersionStorage/Deprecated/VersionResult.pm | 66 ++
.../VersionStorage/Deprecated/VersionResultSet.pm | 99 +++
.../DeploymentHandler/VersionStorage/Standard.pm | 81 ++
.../VersionStorage/Standard/Component.pm | 69 ++
.../VersionStorage/Standard/VersionResult.pm | 67 ++
.../VersionStorage/Standard/VersionResultSet.pm | 65 ++
.../DeploymentHandler/WithApplicatorDumple.pm | 97 +++
.../DeploymentHandler/WithReasonableDefaults.pm | 102 +++
t/02-instantiation-no-ddl.t | 163 ++++
t/02-instantiation-wo-component.t | 162 ++++
t/02-instantiation.t | 162 ++++
t/03-deprecated.t | 123 +++
t/04-preconnect.t | 40 +
t/bugs/01-emailed-bug-01.t | 44 +
t/deploy_methods/sql_translator.t | 247 ++++++
t/deploy_methods/sql_translator_deprecated.t | 93 ++
.../sql_translator_protoschema_transform.t | 67 ++
t/lib/DBICDHTest.pm | 17 +
t/lib/DBICVersion_v1.pm | 32 +
t/lib/DBICVersion_v2.pm | 37 +
t/lib/DBICVersion_v3.pm | 42 +
t/lib/DBICVersion_v4.pm | 37 +
t/no-component-lib/DBICDHTest.pm | 17 +
t/no-component-lib/DBICVersion_v1.pm | 31 +
t/no-component-lib/DBICVersion_v2.pm | 36 +
t/no-component-lib/DBICVersion_v3.pm | 41 +
t/no-component-lib/DBICVersion_v4.pm | 36 +
t/release-pod-syntax.t | 15 +
t/sql/SQLite/deploy/1.0/001-auto-__VERSION.sql | 18 +
t/sql/_source/deploy/1.0/001-auto-__VERSION.yml | 173 ++++
t/version_handlers/db_schema_versions.t | 70 ++
t/version_handlers/explict_versions.t | 138 +++
t/version_handlers/monotonic.t | 129 +++
t/version_storages/standard.t | 94 +++
weaver.ini | 22 +
60 files changed, 6895 insertions(+)
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..f0719ee
--- /dev/null
+++ b/Changes
@@ -0,0 +1,86 @@
+Revision history for DBIx-Class-DeploymentHandler
+
+0.001004 2010-07-29 22:09:10 CST6CDT
+ - Fix incorrect POD in SYNOPSIS
+ - Add missing attribute to DBIx::Class::DeploymentHandler (force_overwrite)
+
+0.001003 2010-07-15 20:30:37 CST6CDT
+ - Add Catalyst-y intro (norkakn)
+ - fix bug caused by install_version_storage not passing a required param
+ - add force_overwrite attribute to SQLTDM
+
+0.001002 2010-07-07 21:11:45 CST6CDT
+ - Add basic intro (norkakn)
+ - install should now work in all cases, previously had a really bad bug
+ where it would try to install the version storage table twice, which
+ breaks everything
+ - Fix issue where the ignore_version connect attr doesn't work in all
+ situations
+
+0.001001 2010-06-26 10:46:03 CST6CDT
+ - Fix bad parameters in version_storage install methods
+ - Fix Try::Tiny typo
+
+0.001000 2010-06-10 21:55:40 CST6CDT
+ - Use package logger instead of default logger
+
+0.001000_14 2010-06-03 20:17:03 CST6CDT
+ - Rename preinstall to initialize
+
+0.001000_13 2010-06-01 23:30:15 CST6CDT
+ - No more serialized SQL, we serialize the SQLT schema instead
+ - Completely reorganize the name of directories for more user friendlyness
+ - take out support for _generic since it's against my creed
+
+0.001000_12 2010-05-27 19:12:20 CST6CDT
+ - Add missing dep
+ - Better defaults and cascading for Logging
+ - Die on SQL errors
+
+0.001000_11 2010-05-21 00:16:13 CST6CDT
+ - Make default (and preferred) way of using this tool serialized SQL
+ instead of just sql files
+ - Add logging with Log::Contextual
+
+0.001000_10 2010-05-18 00:07:31 CST6CDT
+ - upgrade_directory is wrong and vague, instead we use script_directory
+ - stricter validation (no undef) on versions to prevent weird surprises
+ - change method args to named args
+ - document method args
+ - preconnect should not connect to the database
+
+0.001000_09 2010-05-15 23:19:05 CST6CDT
+ - Schemata is no longer required to add version checking component
+
+0.001000_08 2010-05-11 22:42:20 CST6CDT
+ - Add missing dep namespace::autoclean
+
+0.001000_07 2010-05-09 01:59:59 CST6CDT
+ - Downgrades swap from version and to version, so instead of up 1-2
+ being down 1-2, it's down 2-1, which clearly makes more sense
+ - perl scripts are now just anonymous subroutines, instead of files
+ with a single run subroutine
+ - Serious changes to architecture by using MXRP instead
+ of lots of repetitive roles
+
+0.001000_06 2010-05-05 00:46:24 CST6CDT
+ - Add a bunch of boilerplate and not so boilerplate doc
+ - rename sqltargs attribute to sql_translator_args
+
+0.001000_05 2010-05-04 13:37:29 CST6CDT
+ - put schema_version attr in more places
+
+0.001000_04 2010-04-27 13:29:14 CST6CDT
+ - schema_version is now an attr so that users can more easily force the
+ version of the schema
+ - add prepare_install method which installs everything as well as the
+ version storage
+
+0.001000_03 2010-04-20 23:19:36 CST6CDT
+ - bump File::Path dep
+
+0.001000_02 2010-04-19 18:46:16 CST6CDT
+ - add autodie as dep
+
+0.001000_01
+ - initial dev release
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..7cd9d37
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,377 @@
+This software is copyright (c) 2010 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) 2010 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.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307, 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.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) 19yy <name of author>
+
+ 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307, 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.
+
+ <signature of Ty Coon>, 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) 2010 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
+
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..6fbac7e
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,60 @@
+Changes
+LICENSE
+MANIFEST
+META.json
+Makefile.PL
+README
+dist.ini
+lib/DBIx/Class/DeploymentHandler.pm
+lib/DBIx/Class/DeploymentHandler/Cookbook/CustomResultSource.pod
+lib/DBIx/Class/DeploymentHandler/Dad.pm
+lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
+lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator/Deprecated.pm
+lib/DBIx/Class/DeploymentHandler/Deprecated.pm
+lib/DBIx/Class/DeploymentHandler/HandlesDeploy.pm
+lib/DBIx/Class/DeploymentHandler/HandlesVersionStorage.pm
+lib/DBIx/Class/DeploymentHandler/HandlesVersioning.pm
+lib/DBIx/Class/DeploymentHandler/Logger.pm
+lib/DBIx/Class/DeploymentHandler/Manual/CatalystIntro.pod
+lib/DBIx/Class/DeploymentHandler/Manual/Intro.pod
+lib/DBIx/Class/DeploymentHandler/Types.pm
+lib/DBIx/Class/DeploymentHandler/VersionHandler/DatabaseToSchemaVersions.pm
+lib/DBIx/Class/DeploymentHandler/VersionHandler/ExplicitVersions.pm
+lib/DBIx/Class/DeploymentHandler/VersionHandler/Monotonic.pm
+lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated.pm
+lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated/Component.pm
+lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated/VersionResult.pm
+lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated/VersionResultSet.pm
+lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard.pm
+lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard/Component.pm
+lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard/VersionResult.pm
+lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard/VersionResultSet.pm
+lib/DBIx/Class/DeploymentHandler/WithApplicatorDumple.pm
+lib/DBIx/Class/DeploymentHandler/WithReasonableDefaults.pm
+t/02-instantiation-no-ddl.t
+t/02-instantiation-wo-component.t
+t/02-instantiation.t
+t/03-deprecated.t
+t/04-preconnect.t
+t/bugs/01-emailed-bug-01.t
+t/deploy_methods/sql_translator.t
+t/deploy_methods/sql_translator_deprecated.t
+t/deploy_methods/sql_translator_protoschema_transform.t
+t/lib/DBICDHTest.pm
+t/lib/DBICVersion_v1.pm
+t/lib/DBICVersion_v2.pm
+t/lib/DBICVersion_v3.pm
+t/lib/DBICVersion_v4.pm
+t/no-component-lib/DBICDHTest.pm
+t/no-component-lib/DBICVersion_v1.pm
+t/no-component-lib/DBICVersion_v2.pm
+t/no-component-lib/DBICVersion_v3.pm
+t/no-component-lib/DBICVersion_v4.pm
+t/release-pod-syntax.t
+t/sql/SQLite/deploy/1.0/001-auto-__VERSION.sql
+t/sql/_source/deploy/1.0/001-auto-__VERSION.yml
+t/version_handlers/db_schema_versions.t
+t/version_handlers/explict_versions.t
+t/version_handlers/monotonic.t
+t/version_storages/standard.t
+weaver.ini
diff --git a/META.json b/META.json
new file mode 100644
index 0000000..380dddd
--- /dev/null
+++ b/META.json
@@ -0,0 +1,54 @@
+{
+ "abstract" : "Extensible DBIx::Class deployment",
+ "author" : [
+ "Arthur Axel \"fREW\" Schmidt <frioux+cpan at gmail.com>"
+ ],
+ "dynamic_config" : 0,
+ "generated_by" : "Dist::Zilla version 4.101900, CPAN::Meta::Converter version 2.101670",
+ "license" : [
+ "perl_5"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "DBIx-Class-DeploymentHandler",
+ "prereqs" : {
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "6.31"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "Carp" : 0,
+ "Carp::Clan" : 0,
+ "DBD::SQLite" : 0,
+ "DBIx::Class" : "0.08121",
+ "File::Path" : "2.08",
+ "File::Touch" : "0.08",
+ "Log::Contextual" : "0.00300",
+ "Method::Signatures::Simple" : "0.05",
+ "Moose" : "1.0",
+ "MooseX::Role::Parameterized" : "0.18",
+ "SQL::Translator" : "0.11005",
+ "Test::Exception" : 0,
+ "Test::More" : "0.88",
+ "Try::Tiny" : 0,
+ "aliased" : 0,
+ "autodie" : 0,
+ "namespace::autoclean" : 0
+ }
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "repository" : {
+ "type" : "git",
+ "url" : "git://git.shadowcat.co.uk/dbsrgits/DBIx-Class-DeploymentHandler.git",
+ "web" : "http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/DBIx-Class-DeploymentHandler.git"
+ }
+ },
+ "version" : "0.001004"
+}
+
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..3d9ba1d
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,67 @@
+
+use strict;
+use warnings;
+
+
+
+use ExtUtils::MakeMaker 6.31;
+
+
+
+my %WriteMakefileArgs = (
+ 'ABSTRACT' => 'Extensible DBIx::Class deployment',
+ 'AUTHOR' => 'Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>',
+ 'BUILD_REQUIRES' => {},
+ 'CONFIGURE_REQUIRES' => {
+ 'ExtUtils::MakeMaker' => '6.31'
+ },
+ 'DISTNAME' => 'DBIx-Class-DeploymentHandler',
+ 'EXE_FILES' => [],
+ 'LICENSE' => 'perl',
+ 'NAME' => 'DBIx::Class::DeploymentHandler',
+ 'PREREQ_PM' => {
+ 'Carp' => '0',
+ 'Carp::Clan' => '0',
+ 'DBD::SQLite' => '0',
+ 'DBIx::Class' => '0.08121',
+ 'File::Path' => '2.08',
+ 'File::Touch' => '0.08',
+ 'Log::Contextual' => '0.00300',
+ 'Method::Signatures::Simple' => '0.05',
+ 'Moose' => '1.0',
+ 'MooseX::Role::Parameterized' => '0.18',
+ 'SQL::Translator' => '0.11005',
+ 'Test::Exception' => '0',
+ 'Test::More' => '0.88',
+ 'Try::Tiny' => '0',
+ 'aliased' => '0',
+ 'autodie' => '0',
+ 'namespace::autoclean' => '0'
+ },
+ 'VERSION' => '0.001004',
+ 'test' => {
+ 'TESTS' => 't/*.t t/bugs/*.t t/deploy_methods/*.t t/version_handlers/*.t t/version_storages/*.t'
+ }
+);
+
+
+unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) {
+ my $br = delete $WriteMakefileArgs{BUILD_REQUIRES};
+ my $pp = $WriteMakefileArgs{PREREQ_PM};
+ for my $mod ( keys %$br ) {
+ if ( exists $pp->{$mod} ) {
+ $pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod};
+ }
+ else {
+ $pp->{$mod} = $br->{$mod};
+ }
+ }
+}
+
+delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
+ unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
+
+WriteMakefile(%WriteMakefileArgs);
+
+
+
diff --git a/README b/README
new file mode 100644
index 0000000..068ac10
--- /dev/null
+++ b/README
@@ -0,0 +1,150 @@
+NAME
+ DBIx::Class::DeploymentHandler - Extensible DBIx::Class deployment
+
+SYNOPSIS
+ use aliased 'DBIx::Class::DeploymentHandler' => 'DH';
+ my $s = My::Schema->connect(...);
+
+ my $dh = DH->new({
+ schema => $s,
+ databases => 'SQLite',
+ sql_translator_args => { add_drop_table => 0 },
+ });
+
+ $dh->prepare_install;
+
+ $dh->install;
+
+ or for upgrades:
+
+ use aliased 'DBIx::Class::DeploymentHandler' => 'DH';
+ my $s = My::Schema->connect(...);
+
+ my $dh = DH->new({
+ schema => $s,
+ databases => 'SQLite',
+ sql_translator_args => { add_drop_table => 0 },
+ });
+
+ $dh->prepare_upgrade({
+ from_version => 1,
+ to_version => 2,
+ });
+
+ $dh->upgrade;
+
+DESCRIPTION
+ "DBIx::Class::DeploymentHandler" is, as it's name suggests, a tool for
+ deploying and upgrading databases with DBIx::Class. It is designed to be
+ much more flexible than DBIx::Class::Schema::Versioned, hence the use of
+ Moose and lots of roles.
+
+ "DBIx::Class::DeploymentHandler" itself is just a recommended set of
+ roles that we think will not only work well for everyone, but will also
+ yeild the best overall mileage. Each role it uses has it's own nuances
+ and documentation, so I won't describe all of them here, but here are a
+ few of the major benefits over how DBIx::Class::Schema::Versioned worked
+ (and DBIx::Class::DeploymentHandler::Deprecated tries to maintain
+ compatibility with):
+
+ * Downgrades in addition to upgrades.
+
+ * Multiple sql files files per upgrade/downgrade/install.
+
+ * Perl scripts allowed for upgrade/downgrade/install.
+
+ * Just one set of files needed for upgrade, unlike before where one
+ might need to generate "factorial(scalar @versions)", which is just
+ silly.
+
+ * And much, much more!
+
+ That's really just a taste of some of the differences. Check out each
+ role for all the details.
+
+WHERE IS ALL THE DOC?!
+ "DBIx::Class::DeploymentHandler" extends
+ DBIx::Class::DeploymentHandler::Dad, so that's probably the first place
+ to look when you are trying to figure out how everything works.
+
+ Next would be to look at all the pieces that fill in the blanks that
+ DBIx::Class::DeploymentHandler::Dad expects to be filled. They would be
+ DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator,
+ DBIx::Class::DeploymentHandler::VersionHandler::Monotonic,
+ DBIx::Class::DeploymentHandler::VersionStorage::Standard, and
+ DBIx::Class::DeploymentHandler::WithReasonableDefaults.
+
+THIS SUCKS
+ You started your project and weren't using
+ "DBIx::Class::DeploymentHandler"? Lucky for you I had you in mind when I
+ wrote this doc.
+
+ First off, you'll want to just install the "version_storage":
+
+ my $s = My::Schema->connect(...);
+ my $dh = DBIx::Class::DeploymentHandler->({ schema => $s });
+
+ $dh->prepare_version_storage_install;
+ $dh->install_version_storage;
+
+ Then set your database version:
+
+ $dh->add_database_version({ version => $s->version });
+
+ Now you should be able to use "DBIx::Class::DeploymentHandler" like
+ normal!
+
+LOGGING
+ This is a complex tool, and because of that sometimes you'll want to see
+ what exactly is happening. The best way to do that is to use the built
+ in logging functionality. It the standard six log levels; "fatal",
+ "error", "warn", "info", "debug", and "trace". Most of those are pretty
+ self explanatory. Generally a safe level to see what all is going on is
+ debug, which will give you everything except for the exact SQL being
+ run.
+
+ To enable the various logging levels all you need to do is set an
+ environment variables: "DBICDH_FATAL", "DBICDH_ERROR", "DBICDH_WARN",
+ "DBICDH_INFO", "DBICDH_DEBUG", and "DBICDH_TRACE". Each level can be set
+ on it's own, but the default is the first three on and the last three
+ off, and the levels cascade, so if you turn on trace the rest will turn
+ on automatically.
+
+DONATIONS
+ If you'd like to thank me for the work I've done on this module, don't
+ give me a donation. I spend a lot of free time creating free software,
+ but I do it because I love it.
+
+ Instead, consider donating to someone who might actually need it.
+ Obviously you should do research when donating to a charity, so don't
+ just take my word on this. I like Children's Survival Fund:
+ <http://www.childrenssurvivalfund.org>, but there are a host of other
+ charities that can do much more good than I will with your money.
+
+METHODS
+ prepare_version_storage_install
+ $dh->prepare_version_storage_install
+
+ Creates the needed ".sql" file to install the version storage and not
+ the rest of the tables
+
+ prepare_install
+ $dh->prepare_install
+
+ First prepare all the tables to be installed and the prepare just the
+ version storage
+
+ install_version_storage
+ $dh->install_version_storage
+
+ Install the version storage and not the rest of the tables
+
+AUTHOR
+ Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+COPYRIGHT AND LICENSE
+ This software is copyright (c) 2010 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.
+
diff --git a/dist.ini b/dist.ini
new file mode 100644
index 0000000..ffd18ad
--- /dev/null
+++ b/dist.ini
@@ -0,0 +1,41 @@
+name = DBIx-Class-DeploymentHandler
+author = Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+license = Perl_5
+copyright_holder = Arthur Axel "fREW" Schmidt
+version = 0.001004
+
+[NextRelease]
+[@Git]
+[@Filter]
+bundle = @Basic
+remove = MetaYAML
+
+[MetaResources]
+repository.url = git://git.shadowcat.co.uk/dbsrgits/DBIx-Class-DeploymentHandler.git
+repository.web = http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/DBIx-Class-DeploymentHandler.git
+repository.type = git
+
+[MetaJSON]
+[PodWeaver]
+[PkgVersion]
+[ReadmeFromPod]
+[PodSyntaxTests]
+
+[Prereq]
+autodie = 0
+namespace::autoclean = 0
+Log::Contextual = 0.00300
+File::Path = 2.08
+File::Touch = 0.08
+DBIx::Class = 0.08121
+Moose = 1.0
+Method::Signatures::Simple = 0.05
+MooseX::Role::Parameterized = 0.18
+Try::Tiny = 0
+SQL::Translator = 0.11005
+Test::More = 0.88
+Test::Exception = 0
+DBD::SQLite = 0
+Carp = 0
+Carp::Clan = 0
+aliased = 0
diff --git a/lib/DBIx/Class/DeploymentHandler.pm b/lib/DBIx/Class/DeploymentHandler.pm
new file mode 100644
index 0000000..5a7f40a
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler.pm
@@ -0,0 +1,249 @@
+package DBIx::Class::DeploymentHandler;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::VERSION = '0.001004';
+}
+
+# ABSTRACT: Extensible DBIx::Class deployment
+
+use Moose;
+
+extends 'DBIx::Class::DeploymentHandler::Dad';
+# a single with would be better, but we can't do that
+# see: http://rt.cpan.org/Public/Bug/Display.html?id=46347
+with 'DBIx::Class::DeploymentHandler::WithApplicatorDumple' => {
+ interface_role => 'DBIx::Class::DeploymentHandler::HandlesDeploy',
+ class_name => 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator',
+ delegate_name => 'deploy_method',
+ attributes_to_assume => [qw(schema schema_version)],
+ attributes_to_copy => [qw(
+ ignore_ddl databases script_directory sql_translator_args force_overwrite
+ )],
+ },
+ 'DBIx::Class::DeploymentHandler::WithApplicatorDumple' => {
+ interface_role => 'DBIx::Class::DeploymentHandler::HandlesVersioning',
+ class_name => 'DBIx::Class::DeploymentHandler::VersionHandler::Monotonic',
+ delegate_name => 'version_handler',
+ attributes_to_assume => [qw( database_version schema_version to_version )],
+ },
+ 'DBIx::Class::DeploymentHandler::WithApplicatorDumple' => {
+ interface_role => 'DBIx::Class::DeploymentHandler::HandlesVersionStorage',
+ class_name => 'DBIx::Class::DeploymentHandler::VersionStorage::Standard',
+ delegate_name => 'version_storage',
+ attributes_to_assume => ['schema'],
+ };
+with 'DBIx::Class::DeploymentHandler::WithReasonableDefaults';
+
+sub prepare_version_storage_install {
+ my $self = shift;
+
+ $self->prepare_resultsource_install({
+ result_source => $self->version_storage->version_rs->result_source
+ });
+}
+
+sub install_version_storage {
+ my $self = shift;
+
+ my $version = (shift||{})->{version} || $self->schema_version;
+
+ $self->install_resultsource({
+ result_source => $self->version_storage->version_rs->result_source,
+ version => $version,
+ });
+}
+
+sub prepare_install {
+ $_[0]->prepare_deploy;
+ $_[0]->prepare_version_storage_install;
+}
+
+# the following is just a hack so that ->version_storage
+# won't be lazy
+sub BUILD { $_[0]->version_storage }
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+#vim: ts=2 sw=2 expandtab
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler - Extensible DBIx::Class deployment
+
+=head1 SYNOPSIS
+
+ use aliased 'DBIx::Class::DeploymentHandler' => 'DH';
+ my $s = My::Schema->connect(...);
+
+ my $dh = DH->new({
+ schema => $s,
+ databases => 'SQLite',
+ sql_translator_args => { add_drop_table => 0 },
+ });
+
+ $dh->prepare_install;
+
+ $dh->install;
+
+or for upgrades:
+
+ use aliased 'DBIx::Class::DeploymentHandler' => 'DH';
+ my $s = My::Schema->connect(...);
+
+ my $dh = DH->new({
+ schema => $s,
+ databases => 'SQLite',
+ sql_translator_args => { add_drop_table => 0 },
+ });
+
+ $dh->prepare_upgrade({
+ from_version => 1,
+ to_version => 2,
+ });
+
+ $dh->upgrade;
+
+=head1 DESCRIPTION
+
+C<DBIx::Class::DeploymentHandler> is, as it's name suggests, a tool for
+deploying and upgrading databases with L<DBIx::Class>. It is designed to be
+much more flexible than L<DBIx::Class::Schema::Versioned>, hence the use of
+L<Moose> and lots of roles.
+
+C<DBIx::Class::DeploymentHandler> itself is just a recommended set of roles
+that we think will not only work well for everyone, but will also yeild the
+best overall mileage. Each role it uses has it's own nuances and
+documentation, so I won't describe all of them here, but here are a few of the
+major benefits over how L<DBIx::Class::Schema::Versioned> worked (and
+L<DBIx::Class::DeploymentHandler::Deprecated> tries to maintain compatibility
+with):
+
+=over
+
+=item *
+
+Downgrades in addition to upgrades.
+
+=item *
+
+Multiple sql files files per upgrade/downgrade/install.
+
+=item *
+
+Perl scripts allowed for upgrade/downgrade/install.
+
+=item *
+
+Just one set of files needed for upgrade, unlike before where one might need
+to generate C<factorial(scalar @versions)>, which is just silly.
+
+=item *
+
+And much, much more!
+
+=back
+
+That's really just a taste of some of the differences. Check out each role for
+all the details.
+
+=head1 WHERE IS ALL THE DOC?!
+
+C<DBIx::Class::DeploymentHandler> extends
+L<DBIx::Class::DeploymentHandler::Dad>, so that's probably the first place to
+look when you are trying to figure out how everything works.
+
+Next would be to look at all the pieces that fill in the blanks that
+L<DBIx::Class::DeploymentHandler::Dad> expects to be filled. They would be
+L<DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator>,
+L<DBIx::Class::DeploymentHandler::VersionHandler::Monotonic>,
+L<DBIx::Class::DeploymentHandler::VersionStorage::Standard>, and
+L<DBIx::Class::DeploymentHandler::WithReasonableDefaults>.
+
+=head1 THIS SUCKS
+
+You started your project and weren't using C<DBIx::Class::DeploymentHandler>?
+Lucky for you I had you in mind when I wrote this doc.
+
+First off, you'll want to just install the C<version_storage>:
+
+ my $s = My::Schema->connect(...);
+ my $dh = DBIx::Class::DeploymentHandler->({ schema => $s });
+
+ $dh->prepare_version_storage_install;
+ $dh->install_version_storage;
+
+Then set your database version:
+
+ $dh->add_database_version({ version => $s->version });
+
+Now you should be able to use C<DBIx::Class::DeploymentHandler> like normal!
+
+=head1 LOGGING
+
+This is a complex tool, and because of that sometimes you'll want to see
+what exactly is happening. The best way to do that is to use the built in
+logging functionality. It the standard six log levels; C<fatal>, C<error>,
+C<warn>, C<info>, C<debug>, and C<trace>. Most of those are pretty self
+explanatory. Generally a safe level to see what all is going on is debug,
+which will give you everything except for the exact SQL being run.
+
+To enable the various logging levels all you need to do is set an environment
+variables: C<DBICDH_FATAL>, C<DBICDH_ERROR>, C<DBICDH_WARN>, C<DBICDH_INFO>,
+C<DBICDH_DEBUG>, and C<DBICDH_TRACE>. Each level can be set on it's own,
+but the default is the first three on and the last three off, and the levels
+cascade, so if you turn on trace the rest will turn on automatically.
+
+=head1 DONATIONS
+
+If you'd like to thank me for the work I've done on this module, don't give me
+a donation. I spend a lot of free time creating free software, but I do it
+because I love it.
+
+Instead, consider donating to someone who might actually need it. Obviously
+you should do research when donating to a charity, so don't just take my word
+on this. I like Children's Survival Fund:
+L<http://www.childrenssurvivalfund.org>, but there are a host of other
+charities that can do much more good than I will with your money.
+
+=head1 METHODS
+
+=head2 prepare_version_storage_install
+
+ $dh->prepare_version_storage_install
+
+Creates the needed C<.sql> file to install the version storage and not the rest
+of the tables
+
+=head2 prepare_install
+
+ $dh->prepare_install
+
+First prepare all the tables to be installed and the prepare just the version
+storage
+
+=head2 install_version_storage
+
+ $dh->install_version_storage
+
+Install the version storage and not the rest of the tables
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
+
diff --git a/lib/DBIx/Class/DeploymentHandler/Cookbook/CustomResultSource.pod b/lib/DBIx/Class/DeploymentHandler/Cookbook/CustomResultSource.pod
new file mode 100644
index 0000000..39bfa3d
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/Cookbook/CustomResultSource.pod
@@ -0,0 +1,115 @@
+package DBIx::Class::DeploymentHandler::Cookbook::CustomResultSource;
+
+
+__END__
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::Cookbook::CustomResultSource
+
+One of the reasons for the absurd level of flexibility that
+L<DBIx::Class::DeploymentHandler> is so that you can do things that we did not
+originally anticipate. Surprisingly, I never added a method to change the
+table for the version storage. That's fine though, the following recipe
+shows how one can do it in style:
+
+=head2 Version Storage
+
+ package MyApp::Schema::DBICDHStorage;
+ use Moose;
+ extends 'DBIx::Class::DeploymentHandler::VersionStorage::Standard';
+
+ sub _build_version_rs {
+ $_[0]->schema->register_class(
+ __VERSION =>
+ 'MyApp::Schema::DBICDHStorageResult'
+ );
+ $_[0]->schema->resultset('__VERSION')
+ }
+
+ no Moose;
+ __PACKAGE__->meta->make_immutable;
+ 1;
+
+There's not a whole lot special there. The only real bit of code to point out
+is the C<register_class> call. We make sure to point C<__VERSION> to the
+result class that we will define next.
+
+=head2 Version Result Class
+
+ package MyApp::Schema::DBICDHStorageResult;
+ use parent 'DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult';
+ __PACKAGE__->table('fl_bench_journal_versions');
+ 1;
+
+As you can see, this is almost silly how simple it is, we just change the
+table being set on the original result.
+
+=head2 Our very own DeploymentHandler
+
+ package MyApp::Schema::DeploymentHandler;
+ use Moose;
+ extends 'DBIx::Class::DeploymentHandler::Dad';
+
+ # a single with would be better, but we can't do that
+ # see: http://rt.cpan.org/Public/Bug/Display.html?id=46347
+ with 'DBIx::Class::DeploymentHandler::WithApplicatorDumple' => {
+ interface_role => 'DBIx::Class::DeploymentHandler::HandlesDeploy',
+ class_name => 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator',
+ delegate_name => 'deploy_method',
+ attributes_to_assume => ['schema'],
+ attributes_to_copy => [qw( databases script_directory sql_translator_args )],
+ },
+ 'DBIx::Class::DeploymentHandler::WithApplicatorDumple' => {
+ interface_role => 'DBIx::Class::DeploymentHandler::HandlesVersioning',
+ class_name => 'DBIx::Class::DeploymentHandler::VersionHandler::Monotonic',
+ delegate_name => 'version_handler',
+ attributes_to_assume => [qw( database_version schema_version to_version )],
+ },
+ 'DBIx::Class::DeploymentHandler::WithApplicatorDumple' => {
+ interface_role => 'DBIx::Class::DeploymentHandler::HandlesVersionStorage',
+ class_name => 'MyApp::Schema::DBICDHStorage',
+ delegate_name => 'version_storage',
+ attributes_to_assume => ['schema'],
+ };
+ with 'DBIx::Class::DeploymentHandler::WithReasonableDefaults';
+
+ sub prepare_version_storage_install {
+ my $self = shift;
+
+ $self->prepare_resultsource_install(
+ $self->version_storage->version_rs->result_source
+ );
+ }
+
+ sub install_version_storage {
+ my $self = shift;
+
+ $self->install_resultsource(
+ $self->version_storage->version_rs->result_source
+ );
+ }
+
+ sub prepare_install {
+ $_[0]->prepare_deploy;
+ $_[0]->prepare_version_storage_install;
+ }
+
+ no Moose;
+ __PACKAGE__->meta->make_immutable;
+ 1;
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/DBIx/Class/DeploymentHandler/Dad.pm b/lib/DBIx/Class/DeploymentHandler/Dad.pm
new file mode 100644
index 0000000..3b3c51e
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/Dad.pm
@@ -0,0 +1,266 @@
+package DBIx::Class::DeploymentHandler::Dad;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::Dad::VERSION = '0.001004';
+}
+
+# ABSTRACT: Parent class for DeploymentHandlers
+
+use Moose;
+use Method::Signatures::Simple;
+require DBIx::Class::Schema; # loaded for type constraint
+use Carp::Clan '^DBIx::Class::DeploymentHandler';
+use DBIx::Class::DeploymentHandler::Logger;
+use DBIx::Class::DeploymentHandler::Types;
+use Log::Contextual ':log', -package_logger =>
+ DBIx::Class::DeploymentHandler::Logger->new({
+ env_prefix => 'DBICDH'
+ });
+
+has schema => (
+ isa => 'DBIx::Class::Schema',
+ is => 'ro',
+ required => 1,
+);
+
+has backup_directory => (
+ isa => 'Str',
+ is => 'ro',
+ predicate => 'has_backup_directory',
+);
+
+has to_version => (
+ is => 'ro',
+ isa => 'Str',
+ lazy_build => 1,
+);
+
+sub _build_to_version { $_[0]->schema_version }
+
+has schema_version => (
+ is => 'ro',
+ isa => 'StrSchemaVersion',
+ lazy_build => 1,
+);
+
+sub _build_schema_version { $_[0]->schema->schema_version }
+
+method install {
+ log_info { 'installing version ' . $self->to_version };
+ croak 'Install not possible as versions table already exists in database'
+ if $self->version_storage_is_installed;
+
+ my $ddl = $self->deploy;
+
+ $self->add_database_version({
+ version => $self->to_version,
+ ddl => $ddl,
+ });
+}
+
+sub upgrade {
+ log_info { 'upgrading' };
+ my $self = shift;
+ my $ran_once = 0;
+ while ( my $version_list = $self->next_version_set ) {
+ $ran_once = 1;
+ my ($ddl, $upgrade_sql) = @{
+ $self->upgrade_single_step({ version_set => $version_list })
+ ||[]};
+
+ $self->add_database_version({
+ version => $version_list->[-1],
+ ddl => $ddl,
+ upgrade_sql => $upgrade_sql,
+ });
+ }
+
+ log_warn { 'no need to run upgrade' } unless $ran_once;
+}
+
+sub downgrade {
+ log_info { 'upgrading' };
+ my $self = shift;
+ my $ran_once = 0;
+ while ( my $version_list = $self->previous_version_set ) {
+ $ran_once = 1;
+ $self->downgrade_single_step({ version_set => $version_list });
+
+ # do we just delete a row here? I think so but not sure
+ $self->delete_database_version({ version => $version_list->[-1] });
+ }
+ log_warn { 'no version to run downgrade' } unless $ran_once;
+}
+
+method backup {
+ log_info { 'backing up' };
+ $self->storage->backup($self->backup_directory)
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+# vim: ts=2 sw=2 expandtab
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::Dad - Parent class for DeploymentHandlers
+
+=head1 METHODS THAT ARE REQUIRED IN SUBCLASSES
+
+=head2 deploy
+
+See L<DBIx::Class::DeploymentHandler::HandlesDeploy/deploy>.
+
+=head2 version_storage_is_installed
+
+See L<DBIx::Class::DeploymentHandler::HandlesVersionStorage/version_storage_is_installed>.
+
+=head2 add_database_version
+
+See L<DBIx::Class::DeploymentHandler::HandlesVersionStorage/add_database_version>.
+
+=head2 delete_database_version
+
+See L<DBIx::Class::DeploymentHandler::HandlesVersionStorage/delete_database_version>.
+
+=head2 next_version_set
+
+See L<DBIx::Class::DeploymentHandler::HandlesVersioning/next_version_set>.
+
+=head2 previous_version_set
+
+See L<DBIx::Class::DeploymentHandler::HandlesVersioning/previous_version_set>.
+
+=head2 upgrade_single_step
+
+See L<DBIx::Class::DeploymentHandler::HandlesDeploy/upgrade_single_step>.
+
+=head2 downgrade_single_step
+
+See L<DBIx::Class::DeploymentHandler::HandlesDeploy/downgrade_single_step>.
+
+=head1 ORTHODOX METHODS
+
+These methods are not actually B<required> as things will probably still work
+if you don't implement them, but if you want your subclass to get along with
+other subclasses (or more likely, tools made to use another subclass), you
+should probably implement these too, even if they are no-ops.
+
+=head2 database_version
+
+see L<DBIx::Class::DeploymentHandler::HandlesVersionStorage/database_version>
+
+=head2 prepare_deploy
+
+see L<DBIx::Class::DeploymentHandler::HandlesDeploy/prepare_deploy>
+
+=head2 prepare_resultsource_install
+
+see L<DBIx::Class::DeploymentHandler::HandlesDeploy/prepare_resultsource_install>
+
+=head2 install_resultsource
+
+see L<DBIx::Class::DeploymentHandler::HandlesDeploy/install_resultsource>
+
+=head2 prepare_upgrade
+
+see L<DBIx::Class::DeploymentHandler::HandlesDeploy/prepare_upgrade>
+
+=head2 prepare_downgrade
+
+see L<DBIx::Class::DeploymentHandler::HandlesDeploy/prepare_downgrade>
+
+=head2 SUBCLASSING
+
+All of the methods mentioned in L</METHODS THAT ARE REQUIRED IN SUBCLASSES> and
+L</ORTHODOX METHODS> can be implemented in any fashion you choose. In the
+spirit of code reuse I have used roles to implement them in my two subclasses,
+L<DBIx::Class::DeploymentHandler> and
+L<DBIx::Class::DeploymentHandler::Deprecated>, but you are free to implement
+them entirely in a subclass if you so choose to.
+
+For in-depth documentation on how methods are supposed to work, see the roles
+L<DBIx::Class::DeploymentHandler::HandlesDeploy>,
+L<DBIx::Class::DeploymentHandler::HandlesVersioning>, and
+L<DBIx::Class::DeploymentHandler::HandlesVersionStorage>.
+
+=head1 ATTRIBUTES
+
+=head2 schema
+
+The L<DBIx::Class::Schema> (B<required>) that is used to talk to the database
+and generate the DDL.
+
+=head2 schema_version
+
+The version that the schema is currently at. Defaults to
+C<< $self->schema->schema_version >>.
+
+=head2 backup_directory
+
+The directory where backups are stored
+
+=head2 to_version
+
+The version (defaults to schema's version) to migrate the database to
+
+=head1 METHODS
+
+=head2 install
+
+ $dh->install
+
+Deploys the current schema into the database. Populates C<version_storage> with
+C<version> and C<ddl>.
+
+B<Note>: you typically need to call C<< $dh->prepare_deploy >> before you call
+this method.
+
+B<Note>: you cannot install on top of an already installed database
+
+=head2 upgrade
+
+ $dh->upgrade
+
+Upgrades the database one step at a time till L</next_version_set>
+returns C<undef>. Each upgrade step will add a C<version>, C<ddl>, and
+C<upgrade_sql> to the version storage (if C<ddl> and/or C<upgrade_sql> are
+returned from L</upgrade_single_step>.
+
+=head2 downgrade
+
+ $dh->downgrade
+
+Downgrades the database one step at a time till L</previous_version_set>
+returns C<undef>. Each downgrade step will delete a C<version> from the
+version storage.
+
+=head2 backup
+
+ $dh->backup
+
+Simply calls backup on the C<< $schema->storage >>, passing in
+C<< $self->backup_directory >> as an argument. Please test yourself before
+assuming it will work.
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
+
diff --git a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
new file mode 100644
index 0000000..17eb591
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
@@ -0,0 +1,933 @@
+package DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::VERSION = '0.001004';
+}
+use Moose;
+
+# ABSTRACT: Manage your SQL and Perl migrations in nicely laid out directories
+
+use autodie;
+use Carp qw( carp croak );
+use DBIx::Class::DeploymentHandler::Logger;
+use Log::Contextual qw(:log :dlog), -package_logger =>
+ DBIx::Class::DeploymentHandler::Logger->new({
+ env_prefix => 'DBICDH'
+ });
+
+use Method::Signatures::Simple;
+use Try::Tiny;
+
+use SQL::Translator;
+require SQL::Translator::Diff;
+
+require DBIx::Class::Storage; # loaded for type constraint
+use DBIx::Class::DeploymentHandler::Types;
+
+use File::Path 'mkpath';
+use File::Spec::Functions;
+
+with 'DBIx::Class::DeploymentHandler::HandlesDeploy';
+
+has ignore_ddl => (
+ isa => 'Bool',
+ is => 'ro',
+ default => undef,
+);
+
+has force_overwrite => (
+ isa => 'Bool',
+ is => 'ro',
+ default => undef,
+);
+
+has schema => (
+ isa => 'DBIx::Class::Schema',
+ is => 'ro',
+ required => 1,
+);
+
+has storage => (
+ isa => 'DBIx::Class::Storage',
+ is => 'ro',
+ lazy_build => 1,
+);
+
+method _build_storage {
+ my $s = $self->schema->storage;
+ $s->_determine_driver;
+ $s
+}
+
+has sql_translator_args => (
+ isa => 'HashRef',
+ is => 'ro',
+ default => sub { {} },
+);
+has script_directory => (
+ isa => 'Str',
+ is => 'ro',
+ required => 1,
+ default => 'sql',
+);
+
+has databases => (
+ coerce => 1,
+ isa => 'DBIx::Class::DeploymentHandler::Databases',
+ is => 'ro',
+ default => sub { [qw( MySQL SQLite PostgreSQL )] },
+);
+
+has txn_wrap => (
+ is => 'ro',
+ isa => 'Bool',
+ default => 1,
+);
+
+has schema_version => (
+ is => 'ro',
+ isa => 'Str',
+ lazy_build => 1,
+);
+
+# this will probably never get called as the DBICDH
+# will be passing down a schema_version normally, which
+# is built the same way, but we leave this in place
+method _build_schema_version { $self->schema->schema_version }
+
+method __ddl_consume_with_prefix($type, $versions, $prefix) {
+ my $base_dir = $self->script_directory;
+
+ my $main = catfile( $base_dir, $type );
+ my $common =
+ catfile( $base_dir, '_common', $prefix, join q(-), @{$versions} );
+
+ my $dir;
+ if (-d $main) {
+ $dir = catfile($main, $prefix, join q(-), @{$versions})
+ } else {
+ if ($self->ignore_ddl) {
+ return []
+ } else {
+ croak "$main does not exist; please write/generate some SQL"
+ }
+ }
+
+ my %files;
+ try {
+ opendir my($dh), $dir;
+ %files =
+ map { $_ => "$dir/$_" }
+ grep { /\.(?:sql|pl|sql-\w+)$/ && -f "$dir/$_" }
+ readdir $dh;
+ closedir $dh;
+ } catch {
+ die $_ unless $self->ignore_ddl;
+ };
+ if (-d $common) {
+ opendir my($dh), $common;
+ for my $filename (grep { /\.(?:sql|pl)$/ && -f catfile($common,$_) } readdir $dh) {
+ unless ($files{$filename}) {
+ $files{$filename} = catfile($common,$filename);
+ }
+ }
+ closedir $dh;
+ }
+
+ return [@files{sort keys %files}]
+}
+
+method _ddl_initialize_consume_filenames($type, $version) {
+ $self->__ddl_consume_with_prefix($type, [ $version ], 'initialize')
+}
+
+method _ddl_schema_consume_filenames($type, $version) {
+ $self->__ddl_consume_with_prefix($type, [ $version ], 'deploy')
+}
+
+method _ddl_protoschema_deploy_consume_filenames($version) {
+ my $base_dir = $self->script_directory;
+
+ my $dir = catfile( $base_dir, '_source', 'deploy', $version);
+ return [] unless -d $dir;
+
+ opendir my($dh), $dir;
+ my %files = map { $_ => "$dir/$_" } grep { /\.yml$/ && -f "$dir/$_" } readdir $dh;
+ closedir $dh;
+
+ return [@files{sort keys %files}]
+}
+
+method _ddl_protoschema_upgrade_consume_filenames($versions) {
+ my $base_dir = $self->script_directory;
+
+ my $dir = catfile( $base_dir, '_preprocess_schema', 'upgrade', join q(-), @{$versions});
+
+ return [] unless -d $dir;
+
+ opendir my($dh), $dir;
+ my %files = map { $_ => "$dir/$_" } grep { /\.pl$/ && -f "$dir/$_" } readdir $dh;
+ closedir $dh;
+
+ return [@files{sort keys %files}]
+}
+
+method _ddl_protoschema_downgrade_consume_filenames($versions) {
+ my $base_dir = $self->script_directory;
+
+ my $dir = catfile( $base_dir, '_preprocess_schema', 'downgrade', join q(-), @{$versions});
+
+ return [] unless -d $dir;
+
+ opendir my($dh), $dir;
+ my %files = map { $_ => "$dir/$_" } grep { /\.pl$/ && -f "$dir/$_" } readdir $dh;
+ closedir $dh;
+
+ return [@files{sort keys %files}]
+}
+
+method _ddl_protoschema_produce_filename($version) {
+ my $dirname = catfile( $self->script_directory, '_source', 'deploy', $version );
+ mkpath($dirname) unless -d $dirname;
+
+ return catfile( $dirname, '001-auto.yml' );
+}
+
+method _ddl_schema_produce_filename($type, $version) {
+ my $dirname = catfile( $self->script_directory, $type, 'deploy', $version );
+ mkpath($dirname) unless -d $dirname;
+
+ return catfile( $dirname, '001-auto.sql' );
+}
+
+method _ddl_schema_upgrade_consume_filenames($type, $versions) {
+ $self->__ddl_consume_with_prefix($type, $versions, 'upgrade')
+}
+
+method _ddl_schema_downgrade_consume_filenames($type, $versions) {
+ $self->__ddl_consume_with_prefix($type, $versions, 'downgrade')
+}
+
+method _ddl_schema_upgrade_produce_filename($type, $versions) {
+ my $dir = $self->script_directory;
+
+ my $dirname = catfile( $dir, $type, 'upgrade', join q(-), @{$versions});
+ mkpath($dirname) unless -d $dirname;
+
+ return catfile( $dirname, '001-auto.sql' );
+}
+
+method _ddl_schema_downgrade_produce_filename($type, $versions, $dir) {
+ my $dirname = catfile( $dir, $type, 'downgrade', join q(-), @{$versions} );
+ mkpath($dirname) unless -d $dirname;
+
+ return catfile( $dirname, '001-auto.sql');
+}
+
+method _run_sql_array($sql) {
+ my $storage = $self->storage;
+
+ $sql = [grep {
+ $_ && # remove blank lines
+ !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/ # strip txn's
+ } map {
+ s/^\s+//; s/\s+$//; # trim whitespace
+ join '', grep { !/^--/ } split /\n/ # remove comments
+ } @$sql];
+
+ Dlog_trace { "Running SQL $_" } $sql;
+ foreach my $line (@{$sql}) {
+ $storage->_query_start($line);
+ # the whole reason we do this is so that we can see the line that was run
+ try {
+ $storage->dbh_do (sub { $_[1]->do($line) });
+ }
+ catch {
+ die "$_ (running line '$line')"
+ };
+ $storage->_query_end($line);
+ }
+ return join "\n", @$sql
+}
+
+method _run_sql($filename) {
+ log_debug { "Running SQL from $filename" };
+ return $self->_run_sql_array($self->_read_sql_file($filename));
+}
+
+method _run_perl($filename) {
+ log_debug { "Running Perl from $filename" };
+ my $filedata = do { local( @ARGV, $/ ) = $filename; <> };
+
+ no warnings 'redefine';
+ my $fn = eval "$filedata";
+ use warnings;
+ Dlog_trace { "Running Perl $_" } $fn;
+
+ if ($@) {
+ carp "$filename failed to compile: $@";
+ } elsif (ref $fn eq 'CODE') {
+ $fn->($self->schema)
+ } else {
+ carp "$filename should define an anonymouse sub that takes a schema but it didn't!";
+ }
+}
+
+method _run_sql_and_perl($filenames, $sql_to_run) {
+ my @files = @{$filenames};
+ my $guard = $self->schema->txn_scope_guard if $self->txn_wrap;
+
+ $self->_run_sql_array($sql_to_run) if $self->ignore_ddl;
+
+ my $sql = ($sql_to_run)?join ";\n", @$sql_to_run:'';
+ FILENAME:
+ for my $filename (@files) {
+ if ($self->ignore_ddl && $filename =~ /^[^_]*-auto.*\.sql$/) {
+ next FILENAME
+ } elsif ($filename =~ /\.sql$/) {
+ $sql .= $self->_run_sql($filename)
+ } elsif ( $filename =~ /\.pl$/ ) {
+ $self->_run_perl($filename)
+ } else {
+ croak "A file ($filename) got to deploy that wasn't sql or perl!";
+ }
+ }
+
+ $guard->commit if $self->txn_wrap;
+
+ return $sql;
+}
+
+sub deploy {
+ my $self = shift;
+ my $version = (shift @_ || {})->{version} || $self->schema_version;
+ log_info { "deploying version $version" };
+ my $sqlt_type = $self->storage->sqlt_type;
+ my $sql;
+ if ($self->ignore_ddl) {
+ $sql = $self->_sql_from_yaml({},
+ '_ddl_protoschema_deploy_consume_filenames', $sqlt_type
+ );
+ }
+ return $self->_run_sql_and_perl($self->_ddl_schema_consume_filenames(
+ $sqlt_type,
+ $version,
+ ), $sql);
+}
+
+sub initialize {
+ my $self = shift;
+ my $args = shift;
+ my $version = $args->{version} || $self->schema_version;
+ log_info { "initializing version $version" };
+ my $storage_type = $args->{storage_type} || $self->storage->sqlt_type;
+
+ my @files = @{$self->_ddl_initialize_consume_filenames(
+ $storage_type,
+ $version,
+ )};
+
+ for my $filename (@files) {
+ # We ignore sql for now (till I figure out what to do with it)
+ if ( $filename =~ /^(.+)\.pl$/ ) {
+ my $filedata = do { local( @ARGV, $/ ) = $filename; <> };
+
+ no warnings 'redefine';
+ my $fn = eval "$filedata";
+ use warnings;
+
+ if ($@) {
+ carp "$filename failed to compile: $@";
+ } elsif (ref $fn eq 'CODE') {
+ $fn->()
+ } else {
+ carp "$filename should define an anonymous sub but it didn't!";
+ }
+ } else {
+ croak "A file ($filename) got to initialize_scripts that wasn't sql or perl!";
+ }
+ }
+}
+
+method _sqldiff_from_yaml($from_version, $to_version, $db, $direction) {
+ my $dir = $self->script_directory;
+ my $sqltargs = {
+ add_drop_table => 1,
+ ignore_constraint_names => 1,
+ ignore_index_names => 1,
+ %{$self->sql_translator_args}
+ };
+
+ my $source_schema;
+ {
+ my $prefilename = $self->_ddl_protoschema_produce_filename($from_version, $dir);
+
+ # should probably be a croak
+ carp("No previous schema file found ($prefilename)")
+ unless -e $prefilename;
+
+ my $t = SQL::Translator->new({
+ %{$sqltargs},
+ debug => 0,
+ trace => 0,
+ parser => 'SQL::Translator::Parser::YAML',
+ });
+
+ my $out = $t->translate( $prefilename )
+ or croak($t->error);
+
+ $source_schema = $t->schema;
+
+ $source_schema->name( $prefilename )
+ unless $source_schema->name;
+ }
+
+ my $dest_schema;
+ {
+ my $filename = $self->_ddl_protoschema_produce_filename($to_version, $dir);
+
+ # should probably be a croak
+ carp("No next schema file found ($filename)")
+ unless -e $filename;
+
+ my $t = SQL::Translator->new({
+ %{$sqltargs},
+ debug => 0,
+ trace => 0,
+ parser => 'SQL::Translator::Parser::YAML',
+ });
+
+ my $out = $t->translate( $filename )
+ or croak($t->error);
+
+ $dest_schema = $t->schema;
+
+ $dest_schema->name( $filename )
+ unless $dest_schema->name;
+ }
+
+ my $transform_files_method = "_ddl_protoschema_${direction}_consume_filenames";
+ my $transforms = $self->_coderefs_per_files(
+ $self->$transform_files_method([$from_version, $to_version])
+ );
+ $_->($source_schema, $dest_schema) for @$transforms;
+
+ return [SQL::Translator::Diff::schema_diff(
+ $source_schema, $db,
+ $dest_schema, $db,
+ $sqltargs
+ )];
+}
+
+method _sql_from_yaml($sqltargs, $from_file, $db) {
+ my $schema = $self->schema;
+ my $version = $self->schema_version;
+
+ my @sql;
+
+ my $actual_file = $self->$from_file($version);
+ for my $yaml_filename (@{
+ DlogS_trace { "generating SQL from Serialized SQL Files: $_" }
+ (ref $actual_file?$actual_file:[$actual_file])
+ }) {
+ my $sqlt = SQL::Translator->new({
+ add_drop_table => 0,
+ parser => 'SQL::Translator::Parser::YAML',
+ %{$sqltargs},
+ producer => $db,
+ });
+
+ push @sql, $sqlt->translate($yaml_filename);
+ if(!@sql) {
+ carp("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
+ return undef;
+ }
+ }
+ return \@sql;
+}
+
+sub _prepare_install {
+ my $self = shift;
+ my $sqltargs = { %{$self->sql_translator_args}, %{shift @_} };
+ my $from_file = shift;
+ my $to_file = shift;
+ my $dir = $self->script_directory;
+ my $databases = $self->databases;
+ my $version = $self->schema_version;
+
+ foreach my $db (@$databases) {
+ my $sql = $self->_sql_from_yaml($sqltargs, $from_file, $db ) or next;
+
+ my $filename = $self->$to_file($db, $version, $dir);
+ if (-e $filename ) {
+ if ($self->force_overwrite) {
+ carp "Overwriting existing DDL file - $filename";
+ unlink $filename;
+ } else {
+ die "Cannot overwrite '$filename', either enable force_overwrite or delete it"
+ }
+ }
+ open my $file, q(>), $filename;
+ print {$file} join ";\n", @$sql;
+ close $file;
+ }
+}
+
+sub _resultsource_install_filename {
+ my ($self, $source_name) = @_;
+ return sub {
+ my ($self, $type, $version) = @_;
+ my $dirname = catfile( $self->script_directory, $type, 'deploy', $version );
+ mkpath($dirname) unless -d $dirname;
+
+ return catfile( $dirname, "001-auto-$source_name.sql" );
+ }
+}
+
+sub _resultsource_protoschema_filename {
+ my ($self, $source_name) = @_;
+ return sub {
+ my ($self, $version) = @_;
+ my $dirname = catfile( $self->script_directory, '_source', 'deploy', $version );
+ mkpath($dirname) unless -d $dirname;
+
+ return catfile( $dirname, "001-auto-$source_name.yml" );
+ }
+}
+
+sub install_resultsource {
+ my ($self, $args) = @_;
+ my $source = $args->{result_source}
+ or die 'result_source must be passed to install_resultsource';
+ my $version = $args->{version}
+ or die 'version must be passed to install_resultsource';
+ log_info { 'installing_resultsource ' . $source->source_name . ", version $version" };
+ my $rs_install_file =
+ $self->_resultsource_install_filename($source->source_name);
+
+ my $files = [
+ $self->$rs_install_file(
+ $self->storage->sqlt_type,
+ $version,
+ )
+ ];
+ $self->_run_sql_and_perl($files);
+}
+
+sub prepare_resultsource_install {
+ my $self = shift;
+ my $source = (shift @_)->{result_source};
+ log_info { 'preparing install for resultsource ' . $source->source_name };
+
+ my $install_filename = $self->_resultsource_install_filename($source->source_name);
+ my $proto_filename = $self->_resultsource_protoschema_filename($source->source_name);
+ $self->prepare_protoschema({
+ parser_args => { sources => [$source->source_name], }
+ }, $proto_filename);
+ $self->_prepare_install({}, $proto_filename, $install_filename);
+}
+
+sub prepare_deploy {
+ log_info { 'preparing deploy' };
+ my $self = shift;
+ $self->prepare_protoschema({
+ # Exclude __VERSION so that it gets installed separately
+ parser_args => { sources => [grep { $_ ne '__VERSION' } $self->schema->sources], }
+ }, '_ddl_protoschema_produce_filename');
+ $self->_prepare_install({}, '_ddl_protoschema_produce_filename', '_ddl_schema_produce_filename');
+}
+
+sub prepare_upgrade {
+ my ($self, $args) = @_;
+ log_info {
+ "preparing upgrade from $args->{from_version} to $args->{to_version}"
+ };
+ $self->_prepare_changegrade(
+ $args->{from_version}, $args->{to_version}, $args->{version_set}, 'upgrade'
+ );
+}
+
+sub prepare_downgrade {
+ my ($self, $args) = @_;
+ log_info {
+ "preparing downgrade from $args->{from_version} to $args->{to_version}"
+ };
+ $self->_prepare_changegrade(
+ $args->{from_version}, $args->{to_version}, $args->{version_set}, 'downgrade'
+ );
+}
+
+method _coderefs_per_files($files) {
+ no warnings 'redefine';
+ [map eval do { local( @ARGV, $/ ) = $_; <> }, @$files]
+}
+
+method _prepare_changegrade($from_version, $to_version, $version_set, $direction) {
+ my $schema = $self->schema;
+ my $databases = $self->databases;
+ my $dir = $self->script_directory;
+
+ my $schema_version = $self->schema_version;
+ my $diff_file_method = "_ddl_schema_${direction}_produce_filename";
+ foreach my $db (@$databases) {
+ my $diff_file = $self->$diff_file_method($db, $version_set, $dir );
+ if(-e $diff_file) {
+ if ($self->force_overwrite) {
+ carp("Overwriting existing $direction-diff file - $diff_file");
+ unlink $diff_file;
+ } else {
+ die "Cannot overwrite '$diff_file', either enable force_overwrite or delete it"
+ }
+ }
+
+ open my $file, q(>), $diff_file;
+ print {$file} join ";\n", @{$self->_sqldiff_from_yaml($from_version, $to_version, $db, $direction)};
+ close $file;
+ }
+}
+
+method _read_sql_file($file) {
+ return unless $file;
+
+ open my $fh, '<', $file;
+ my @data = split /;\n/, join '', <$fh>;
+ close $fh;
+
+ @data = grep {
+ $_ && # remove blank lines
+ !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/ # strip txn's
+ } map {
+ s/^\s+//; s/\s+$//; # trim whitespace
+ join '', grep { !/^--/ } split /\n/ # remove comments
+ } @data;
+
+ return \@data;
+}
+
+sub downgrade_single_step {
+ my $self = shift;
+ my $version_set = (shift @_)->{version_set};
+ Dlog_info { "downgrade_single_step'ing $_" } $version_set;
+
+ my $sqlt_type = $self->storage->sqlt_type;
+ my $sql_to_run;
+ if ($self->ignore_ddl) {
+ $sql_to_run = $self->_sqldiff_from_yaml(
+ $version_set->[0], $version_set->[1], $sqlt_type, 'downgrade',
+ );
+ }
+ my $sql = $self->_run_sql_and_perl($self->_ddl_schema_downgrade_consume_filenames(
+ $sqlt_type,
+ $version_set,
+ ), $sql_to_run);
+
+ return ['', $sql];
+}
+
+sub upgrade_single_step {
+ my $self = shift;
+ my $version_set = (shift @_)->{version_set};
+ Dlog_info { "upgrade_single_step'ing $_" } $version_set;
+
+ my $sqlt_type = $self->storage->sqlt_type;
+ my $sql_to_run;
+ if ($self->ignore_ddl) {
+ $sql_to_run = $self->_sqldiff_from_yaml(
+ $version_set->[0], $version_set->[1], $sqlt_type, 'upgrade',
+ );
+ }
+ my $sql = $self->_run_sql_and_perl($self->_ddl_schema_upgrade_consume_filenames(
+ $sqlt_type,
+ $version_set,
+ ), $sql_to_run);
+ return ['', $sql];
+}
+
+sub prepare_protoschema {
+ my $self = shift;
+ my $sqltargs = { %{$self->sql_translator_args}, %{shift @_} };
+ my $to_file = shift;
+ my $filename
+ = $self->$to_file($self->schema_version);
+
+ # we do this because the code that uses this sets parser args,
+ # so we just need to merge in the package
+ $sqltargs->{parser_args}{package} = $self->schema;
+ my $sqlt = SQL::Translator->new({
+ parser => 'SQL::Translator::Parser::DBIx::Class',
+ producer => 'SQL::Translator::Producer::YAML',
+ %{ $sqltargs },
+ });
+
+ my $yml = $sqlt->translate;
+
+ croak("Failed to translate to YAML: " . $sqlt->error)
+ unless $yml;
+
+ if (-e $filename ) {
+ if ($self->force_overwrite) {
+ carp "Overwriting existing DDL-YML file - $filename";
+ unlink $filename;
+ } else {
+ die "Cannot overwrite '$filename', either enable force_overwrite or delete it"
+ }
+ }
+
+ open my $file, q(>), $filename;
+ print {$file} $yml;
+ close $file;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+# vim: ts=2 sw=2 expandtab
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator - Manage your SQL and Perl migrations in nicely laid out directories
+
+=head1 DESCRIPTION
+
+This class is the meat of L<DBIx::Class::DeploymentHandler>. It takes care
+of generating serialized schemata as well as sql files to move from one
+version of a schema to the rest. One of the hallmark features of this class
+is that it allows for multiple sql files for deploy and upgrade, allowing
+developers to fine tune deployment. In addition it also allows for perl
+files to be run at any stage of the process.
+
+For basic usage see L<DBIx::Class::DeploymentHandler::HandlesDeploy>. What's
+documented here is extra fun stuff or private methods.
+
+=head1 DIRECTORY LAYOUT
+
+Arguably this is the best feature of L<DBIx::Class::DeploymentHandler>.
+It's spiritually based upon L<DBIx::Migration::Directories>, but has a
+lot of extensions and modifications, so even if you are familiar with it,
+please read this. I feel like the best way to describe the layout is with
+the following example:
+
+ $sql_migration_dir
+ |- _source
+ | |- deploy
+ | |- 1
+ | | `- 001-auto.yml
+ | |- 2
+ | | `- 001-auto.yml
+ | `- 3
+ | `- 001-auto.yml
+ |- SQLite
+ | |- downgrade
+ | | `- 2-1
+ | | `- 001-auto.sql
+ | |- deploy
+ | | `- 1
+ | | `- 001-auto.sql
+ | `- upgrade
+ | |- 1-2
+ | | `- 001-auto.sql
+ | `- 2-3
+ | `- 001-auto.sql
+ |- _common
+ | |- downgrade
+ | | `- 2-1
+ | | `- 002-remove-customers.pl
+ | `- upgrade
+ | `- 1-2
+ | `- 002-generate-customers.pl
+ `- MySQL
+ |- downgrade
+ | `- 2-1
+ | `- 001-auto.sql
+ |- initialize
+ | `- 1
+ | |- 001-create_database.pl
+ | `- 002-create_users_and_permissions.pl
+ |- deploy
+ | `- 1
+ | `- 001-auto.sql
+ `- upgrade
+ `- 1-2
+ `- 001-auto.sql
+
+So basically, the code
+
+ $dm->deploy(1)
+
+on an C<SQLite> database that would simply run
+C<$sql_migration_dir/SQLite/deploy/1/001-auto.sql>. Next,
+
+ $dm->upgrade_single_step([1,2])
+
+would run C<$sql_migration_dir/SQLite/upgrade/1-2/001-auto.sql> followed by
+C<$sql_migration_dir/_common/upgrade/1-2/002-generate-customers.pl>.
+
+C<.pl> files don't have to be in the C<_common> directory, but most of the time
+they should be, because perl scripts are generally database independent.
+
+Note that unlike most steps in the process, C<initialize> will not run SQL, as
+there may not even be an database at initialize time. It will run perl scripts
+just like the other steps in the process, but nothing is passed to them.
+Until people have used this more it will remain freeform, but a recommended use
+of initialize is to have it prompt for username and password, and then call the
+appropriate C<< CREATE DATABASE >> commands etc.
+
+=head2 Directory Specification
+
+The following subdirectories are recognized by this DeployMethod:
+
+=over 2
+
+=item C<_source> This directory can contain the following directories:
+
+=over 2
+
+=item C<deploy> This directory merely contains directories named after schema
+versions, which in turn contain C<yaml> files that are serialized versions
+of the schema at that version. These files are not for editing by hand.
+
+=back
+
+=item C<_preprocess_schema> This directory can contain the following
+directories:
+
+=over 2
+
+=item C<downgrade> This directory merely contains directories named after
+migrations, which are of the form C<$from_version-$to_version>. Inside of
+these directories you may put Perl scripts which are to return a subref
+that takes the arguments C<< $from_schema, $to_schema >>, which are
+L<SQL::Translator::Schema> objects.
+
+=item C<upgrade> This directory merely contains directories named after
+migrations, which are of the form C<$from_version-$to_version>. Inside of
+these directories you may put Perl scripts which are to return a subref
+that takes the arguments C<< $from_schema, $to_schema >>, which are
+L<SQL::Translator::Schema> objects.
+
+=back
+
+=item C<$storage_type> This is a set of scripts that gets run depending on what
+your storage type is. If you are not sure what your storage type is, take a
+look at the producers listed for L<SQL::Translator>. Also note, C<_common>
+is a special case. C<_common> will get merged into whatever other files you
+already have. This directory can containt the following directories itself:
+
+=over 2
+
+=item C<initialize> Gets run before the C<deploy> is C<deploy>ed. Has the
+same structure as the C<deploy> subdirectory as well; that is, it has a
+directory for each schema version. Unlike C<deploy>, C<upgrade>, and C<downgrade>
+though, it can only run C<.pl> files, and the coderef in the perl files get
+no arguments passed to them.
+
+=item C<deploy> Gets run when the schema is C<deploy>ed. Structure is a
+directory per schema version, and then files are merged with C<_common> and run
+in filename order. C<.sql> files are merely run, as expected. C<.pl> files are
+run according to L</PERL SCRIPTS>.
+
+=item C<upgrade> Gets run when the schema is C<upgrade>d. Structure is a directory
+per upgrade step, (for example, C<1-2> for upgrading from version 1 to version
+2,) and then files are merged with C<_common> and run in filename order.
+C<.sql> files are merely run, as expected. C<.pl> files are run according
+to L</PERL SCRIPTS>.
+
+=item C<downgrade> Gets run when the schema is C<downgrade>d. Structure is a directory
+per downgrade step, (for example, C<2-1> for downgrading from version 2 to version
+1,) and then files are merged with C<_common> and run in filename order.
+C<.sql> files are merely run, as expected. C<.pl> files are run according
+to L</PERL SCRIPTS>.
+
+=back
+
+=back
+
+=head1 PERL SCRIPTS
+
+A perl script for this tool is very simple. It merely needs to contain an
+anonymous sub that takes a L<DBIx::Class::Schema> as it's only argument.
+A very basic perl script might look like:
+
+ #!perl
+
+ use strict;
+ use warnings;
+
+ sub {
+ my $schema = shift;
+
+ $schema->resultset('Users')->create({
+ name => 'root',
+ password => 'root',
+ })
+ }
+
+=head1 ATTRIBUTES
+
+=head2 ignore_ddl
+
+This attribute will, when set to true (default is false), cause the DM to use
+L<SQL::Translator> to use the C<_source>'s serialized SQL::Translator::Schema
+instead of any pregenerated SQL. If you have a development server this is
+probably the best plan of action as you will not be putting as many generated
+files in your version control. Goes well with with C<databases> of C<[]>.
+
+=head2 force_overwrite
+
+When this attribute is true generated files will be overwritten when the
+methods which create such files are run again. The default is false, in which
+case the program will die with a message saying which file needs to be deleted.
+
+=head2 schema
+
+The L<DBIx::Class::Schema> (B<required>) that is used to talk to the database
+and generate the DDL.
+
+=head2 storage
+
+The L<DBIx::Class::Storage> that is I<actually> used to talk to the database
+and generate the DDL. This is automatically created with L</_build_storage>.
+
+=head2 sql_translator_args
+
+The arguments that get passed to L<SQL::Translator> when it's used.
+
+=head2 script_directory
+
+The directory (default C<'sql'>) that scripts are stored in
+
+=head2 databases
+
+The types of databases (default C<< [qw( MySQL SQLite PostgreSQL )] >>) to
+generate files for
+
+=head2 txn_wrap
+
+Set to true (which is the default) to wrap all upgrades and deploys in a single
+transaction.
+
+=head2 schema_version
+
+The version the schema on your harddrive is at. Defaults to
+C<< $self->schema->schema_version >>.
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
+
diff --git a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator/Deprecated.pm b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator/Deprecated.pm
new file mode 100644
index 0000000..bcab02d
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator/Deprecated.pm
@@ -0,0 +1,131 @@
+package DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::Deprecated;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::Deprecated::VERSION = '0.001004';
+}
+use Moose;
+
+# ABSTRACT: (DEPRECATED) Use this if you are stuck in the past
+
+use Method::Signatures::Simple;
+
+use File::Spec::Functions;
+
+extends 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator',
+
+method _ddl_schema_consume_filenames($type, $version) {
+ return [$self->_ddl_schema_produce_filename($type, $version)]
+}
+
+method _ddl_schema_produce_filename($type, $version) {
+ my $filename = ref $self->schema;
+ $filename =~ s/::/-/g;
+
+ $filename = catfile(
+ $self->script_directory, "$filename-$version-$type.sql"
+ );
+
+ return $filename;
+}
+
+method _ddl_schema_up_produce_filename($type, $versions, $dir) {
+ my $filename = ref $self->schema;
+ $filename =~ s/::/-/g;
+
+ $filename = catfile(
+ $self->script_directory, "$filename-" . join( q(-), @{$versions} ) . "-$type.sql"
+ );
+
+ return $filename;
+}
+
+method _ddl_schema_up_consume_filenames($type, $versions) {
+ return [$self->_ddl_schema_up_produce_filename($type, $versions)]
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+# vim: ts=2 sw=2 expandtab
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::Deprecated - (DEPRECATED) Use this if you are stuck in the past
+
+=head1 DESCRIPTION
+
+All this module does is override a few parts of
+L<DBIx::Class::DeployMethd::SQL::Translator> so that the files generated with
+L<DBIx::Class::Schema::Versioned> will work with this out of the box.
+
+=head1 DEPRECATED
+
+I begrudgingly made this module (and other related modules) to keep porting
+from L<DBIx::Class::Schema::Versioned> relatively simple. I will make changes
+to ensure that it works with output from L<DBIx::Class::Schema::Versioned> etc,
+but I will not add any new features to it.
+
+Once I hit major version 1 usage of this module will emit a warning.
+On version 2 it will be removed entirely.
+
+=head1 THIS SUCKS
+
+Yeah, this old Deprecated thing is a drag. It can't do downgrades, it can only
+use a single .sql file for migrations, it has no .pl support. You should
+totally switch! Here's how:
+
+ my $init_part = ref $schema;
+ $init_part =~ s/::/-/g;
+ opendir my $dh, 'sql';
+ for (readdir $dh) {
+ if (/\Q$init_part\E-(.*)-(.*)(?:-(.*))?/) {
+ if (defined $3) {
+ cp $_, $dh->deploy_method->_ddl_schema_up_produce_filename($3, [$1, $2]);
+ } else {
+ cp $_, $dh->deploy_method->_ddl_schema_produce_filename($2, $1);
+ }
+ }
+ }
+
+=head1 OVERRIDDEN METHODS
+
+=over
+
+=item *
+
+L<DBIx::Class::DeployMethod::SQL::Translator/_ddl_schema_consume_filenames>
+
+=item *
+
+L<DBIx::Class::DeployMethod::SQL::Translator/_ddl_schema_produce_filename>
+
+=item *
+
+L<DBIx::Class::DeployMethod::SQL::Translator/_ddl_schema_up_produce_filename>
+
+=item *
+
+L<DBIx::Class::DeployMethod::SQL::Translator/_ddl_schema_up_consume_filenames>
+
+=back
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
+
diff --git a/lib/DBIx/Class/DeploymentHandler/Deprecated.pm b/lib/DBIx/Class/DeploymentHandler/Deprecated.pm
new file mode 100644
index 0000000..00a3ea0
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/Deprecated.pm
@@ -0,0 +1,146 @@
+package DBIx::Class::DeploymentHandler::Deprecated;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::Deprecated::VERSION = '0.001004';
+}
+
+# ABSTRACT: (DEPRECATED) Use this if you are stuck in the past
+
+use Moose;
+use Moose::Util 'apply_all_roles';
+
+extends 'DBIx::Class::DeploymentHandler::Dad';
+# a single with would be better, but we can't do that
+# see: http://rt.cpan.org/Public/Bug/Display.html?id=46347
+with 'DBIx::Class::DeploymentHandler::WithApplicatorDumple' => {
+ interface_role => 'DBIx::Class::DeploymentHandler::HandlesDeploy',
+ class_name => 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::Deprecated',
+ delegate_name => 'deploy_method',
+ attributes_to_assume => ['schema'],
+ attributes_to_copy => [qw( script_directory databases sql_translator_args )],
+ },
+ 'DBIx::Class::DeploymentHandler::WithApplicatorDumple' => {
+ interface_role => 'DBIx::Class::DeploymentHandler::HandlesVersionStorage',
+ class_name => 'DBIx::Class::DeploymentHandler::VersionStorage::Deprecated',
+ delegate_name => 'version_storage',
+ attributes_to_assume => ['schema'],
+ };
+with 'DBIx::Class::DeploymentHandler::WithReasonableDefaults';
+
+sub BUILD {
+ my $self = shift;
+
+ if ($self->schema->can('ordered_versions') && $self->schema->ordered_versions) {
+ apply_all_roles(
+ $self,
+ 'DBIx::Class::DeploymentHandler::WithApplicatorDumple' => {
+ interface_role => 'DBIx::Class::DeploymentHandler::HandlesVersioning',
+ class_name => 'DBIx::Class::DeploymentHandler::VersionHandler::ExplicitVersions',
+ delegate_name => 'version_handler',
+ attributes_to_assume => [qw( database_version schema_version to_version )],
+ }
+ );
+ } else {
+ apply_all_roles(
+ $self,
+ 'DBIx::Class::DeploymentHandler::WithApplicatorDumple' => {
+ interface_role => 'DBIx::Class::DeploymentHandler::HandlesVersioning',
+ class_name => 'DBIx::Class::DeploymentHandler::VersionHandler::DatabaseToSchemaVersions',
+ delegate_name => 'version_handler',
+ attributes_to_assume => [qw( database_version schema_version to_version )],
+ }
+ );
+ }
+ # the following is just a hack so that ->version_storage
+ # won't be lazy
+ $self->version_storage;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+# vim: ts=2 sw=2 expandtab
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::Deprecated - (DEPRECATED) Use this if you are stuck in the past
+
+=head1 SYNOPSIS
+
+Look at L<DBIx::Class::DeploymentHandler/SYNPOSIS>. I won't repeat
+it here to emphasize, yet again, that this should not be used unless you really
+want to live in the past.
+
+=head1 DEPRECATED
+
+I begrudgingly made this module (and other related modules) to make porting
+from L<DBIx::Class::Schema::Versioned> relatively simple. I will make changes
+to ensure that it works with output from L<DBIx::Class::Schema::Versioned> etc,
+but I will not add any new features to it. It already lacks numerous features
+that the full version provides in style:
+
+=over
+
+=item *
+
+Downgrades
+
+=item *
+
+Multiple files for migrations
+
+=item *
+
+Perl files in migrations
+
+=item *
+
+Shared Perl/SQL for different databases
+
+=back
+
+And there's probably more.
+
+At version 1.000000 usage of this module will emit a warning. At version
+2.000000 it will be removed entirely.
+
+To migrate to the New Hotness take a look at:
+L<DBIx::Class::DeploymentHandler::VersionStorage::Deprecated/THIS SUCKS> and
+L<DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::Deprecated/THIS SUCKS>.
+
+=head1 WHERE IS ALL THE DOC?!
+
+C<DBIx::Class::DeploymentHandler::Deprecated> extends
+L<DBIx::Class::DeploymentHandler::Dad>, so that's probably the first place to
+look when you are trying to figure out how everything works.
+
+Next would be to look at all the pieces that fill in the blanks that
+L<DBIx::Class::DeploymentHandler::Dad> expects to be filled. They would be
+L<DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::Deprecated>,
+L<DBIx::Class::DeploymentHandler::VersionStorage::Deprecated>, and
+L<DBIx::Class::DeploymentHandler::WithReasonableDefaults>. Also, this class
+is special in that it applies either
+L<DBIx::Class::DeploymentHandler::VersionHandler::ExplicitVersions> or
+L<DBIx::Class::DeploymentHandler::VersionHandler::DatabaseToSchemaVersions> depending on
+your schema.
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
+
diff --git a/lib/DBIx/Class/DeploymentHandler/HandlesDeploy.pm b/lib/DBIx/Class/DeploymentHandler/HandlesDeploy.pm
new file mode 100644
index 0000000..8b6bee3
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/HandlesDeploy.pm
@@ -0,0 +1,151 @@
+package DBIx::Class::DeploymentHandler::HandlesDeploy;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::HandlesDeploy::VERSION = '0.001004';
+}
+use Moose::Role;
+
+# ABSTRACT: Interface for deploy methods
+
+requires 'initialize';
+
+requires 'prepare_deploy';
+requires 'deploy';
+
+requires 'prepare_resultsource_install';
+requires 'install_resultsource';
+
+requires 'prepare_upgrade';
+requires 'upgrade_single_step';
+
+requires 'prepare_downgrade';
+requires 'downgrade_single_step';
+
+1;
+
+# vim: ts=2 sw=2 expandtab
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::HandlesDeploy - Interface for deploy methods
+
+=head1 KNOWN IMPLEMENTATIONS
+
+=over
+
+=item *
+
+L<DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator>
+
+=item *
+
+L<DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::Deprecated>
+
+=back
+
+=head1 METHODS
+
+=head2 initialize
+
+ $dh->initialize({
+ version => 1,
+ storage_type => 'SQLite'
+ });
+
+Run scripts before deploying to the database
+
+=head2 prepare_deploy
+
+ $dh->prepare_deploy
+
+Generate the needed data files to install the schema to the database.
+
+=head2 deploy
+
+ $dh->deploy({ version => 1 })
+
+Deploy the schema to the database.
+
+=head2 prepare_resultsource_install
+
+ $dh->prepare_resultsource_install({
+ result_source => $resultset->result_source,
+ })
+
+Takes a L<DBIx::Class::ResultSource> and generates a single migration file to
+create the resultsource's table.
+
+=head2 install_resultsource
+
+ $dh->install_resultsource({
+ result_source => $resultset->result_source,
+ version => 1,
+ })
+
+Takes a L<DBIx::Class::ResultSource> and runs a single migration file to
+deploy the resultsource's table.
+
+=head2 prepare_upgrade
+
+ $dh->prepare_upgrade({
+ from_version => 1,
+ to_version => 2,
+ version_set => [1, 2]
+ });
+
+Takes two versions and a version set. This basically is supposed to generate
+the needed C<SQL> to migrate up from the first version to the second version.
+The version set uniquely identifies the migration.
+
+=head2 prepare_downgrade
+
+ $dh->prepare_downgrade({
+ from_version => 1,
+ to_version => 2,
+ version_set => [1, 2]
+ });
+
+Takes two versions and a version set. This basically is supposed to generate
+the needed C<SQL> to migrate down from the first version to the second version.
+The version set uniquely identifies the migration and should match it's
+respective upgrade version set.
+
+=head2 upgrade_single_step
+
+ my ($ddl, $sql) = @{
+ $dh->upgrade_single_step({ version_set => $version_set })
+ ||[]}
+
+Call a single upgrade migration. Takes a version set as an argument.
+Optionally return C<< [ $ddl, $upgrade_sql ] >> where C<$ddl> is the DDL for
+that version of the schema and C<$upgrade_sql> is the SQL that was run to
+upgrade the database.
+
+=head2 downgrade_single_step
+
+ $dh->downgrade_single_step($version_set);
+
+Call a single downgrade migration. Takes a version set as an argument.
+Optionally return C<< [ $ddl, $upgrade_sql ] >> where C<$ddl> is the DDL for
+that version of the schema and C<$upgrade_sql> is the SQL that was run to
+upgrade the database.
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
+
diff --git a/lib/DBIx/Class/DeploymentHandler/HandlesVersionStorage.pm b/lib/DBIx/Class/DeploymentHandler/HandlesVersionStorage.pm
new file mode 100644
index 0000000..9c9ecd2
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/HandlesVersionStorage.pm
@@ -0,0 +1,93 @@
+package DBIx::Class::DeploymentHandler::HandlesVersionStorage;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::HandlesVersionStorage::VERSION = '0.001004';
+}
+use Moose::Role;
+
+# ABSTRACT: Interface for version storage methods
+
+requires 'add_database_version';
+requires 'database_version';
+requires 'delete_database_version';
+requires 'version_storage_is_installed';
+
+1;
+
+# vim: ts=2 sw=2 expandtab
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::HandlesVersionStorage - Interface for version storage methods
+
+=head1 DESCRIPTION
+
+Typically VersionStorages will be implemented with a simple
+DBIx::Class::Result. Take a look at the
+L<two existing implementations|/KNOWN IMPLEMENTATIONS> for examples of what you
+might want to do in your own storage.
+
+=head1 KNOWN IMPLEMENTATIONS
+
+=over
+
+=item *
+
+L<DBIx::Class::DeploymentHandler::VersionStorage::Standard>
+
+=item *
+
+L<DBIx::Class::DeploymentHandler::VersionStorage::Deprecated>
+
+=back
+
+=head1 METHODS
+
+=head2 add_database_version
+
+ $dh->add_database_version({
+ version => '1.02',
+ ddl => $ddl, # can be undef
+ upgrade_sql => $sql, # can be undef
+ });
+
+Store a new version into the version storage
+
+=head2 database_version
+
+ my $db_version = $version_storage->database_version
+
+Returns the most recently installed version in the database.
+
+=head2 delete_database_version
+
+ $dh->delete_database_version({ version => '1.02' })
+
+Deletes given database version from the version storage
+
+=head2 version_storage_is_installed
+
+ warn q(I can't version this database!)
+ unless $dh->version_storage_is_installed
+
+return true iff the version storage is installed.
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
+
diff --git a/lib/DBIx/Class/DeploymentHandler/HandlesVersioning.pm b/lib/DBIx/Class/DeploymentHandler/HandlesVersioning.pm
new file mode 100644
index 0000000..edac9b6
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/HandlesVersioning.pm
@@ -0,0 +1,159 @@
+package DBIx::Class::DeploymentHandler::HandlesVersioning;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::HandlesVersioning::VERSION = '0.001004';
+}
+use Moose::Role;
+
+# ABSTRACT: Interface for version methods
+
+requires 'next_version_set';
+requires 'previous_version_set';
+
+1;
+
+# vim: ts=2 sw=2 expandtab
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::HandlesVersioning - Interface for version methods
+
+=head1 DESCRIPTION
+
+Typically a VersionHandler will take a C<to_version> and yeild an iterator of
+L<version sets|/VERSION SET>.
+
+Typically a call to a VersionHandler's L</next_version_set> with a C<db_version>
+of 1 and a C<to_version> of 5 will iterate over something like the following:
+
+ [1, 2]
+ [2, 3]
+ [3, 4]
+ [4, 5]
+ undef
+
+or maybe just
+
+ [1, 5]
+ undef
+
+Really how the L<version sets|/VERSION SET> are arranged is up to the
+VersionHandler being used.
+
+In some cases users will not want versions to have inherent "previous
+versions," which is why the version set is an C<ArrayRef>. In those cases the
+user should opt to returning merely the version that the database is being
+upgraded to in each step.
+
+One idea that has been suggested to me has been to have a form of dependency
+management of the database "versions." In this case the versions are actually
+more like features that may or may not be applied. For example, one might
+start with version 1 and have a feature (version) C<users>.
+
+Each feature might require that the database be upgraded to another version
+first. If one were to implement a system like this, here is how the
+VersionHandler's L</next_version_set> might look.
+
+ to_version = "users", db_version = 1
+ [3]
+ [5]
+ ["users"]
+ undef
+
+So what just happened there is that C<users> depends on version 5, which depends
+on version 3, which depends on version 1, which is already installed. To be
+clear, the reason we use single versions instead of version pairs is because
+there is no inherent order for this type of database upgraded.
+
+=head2 Downgrades
+
+For the typical case downgrades should be easy for users to perform and
+understand. That means that with the first two examples given above we can use
+the L</previous_version_set> iterator to yeild the following:
+
+ db_version = 5, to_version=1
+ [5, 4]
+ [4, 3]
+ [3, 2]
+ [2, 1]
+ undef
+
+or maybe just
+
+ [5, 1]
+ undef
+
+Note that we do not swap the version number order. This allows us to remain
+consistent in our version set abstraction, since a version set really just
+describes a version change, and not necesarily a defined progression.
+
+=head1 VERSION SET
+
+A version set could be defined as:
+
+ subtype 'Version', as 'Str';
+ subtype 'VersionSet', as 'ArrayRef[Str]';
+
+A version set should uniquely identify a migration.
+
+=head1 KNOWN IMPLEMENTATIONS
+
+=over
+
+=item *
+
+L<DBIx::Class::DeploymentHandler::VersionHandler::Monotonic>
+
+=item *
+
+L<DBIx::Class::DeploymentHandler::VersionHandler::DatabaseToSchemaVersions>
+
+=item *
+
+L<DBIx::Class::DeploymentHandler::VersionHandler::ExplicitVersions>
+
+=back
+
+=head1 METHODS
+
+=head2 next_version_set
+
+ print 'versions to install: ';
+ while (my $vs = $dh->next_version_set) {
+ print join q(, ), @{$vs}
+ }
+ print qq(\n);
+
+Return a L<version set|/VERSION SET> describing each version that needs to be
+installed to upgrade to C<< $dh->to_version >>.
+
+=head2 previous_version_set
+
+ print 'versions to uninstall: ';
+ while (my $vs = $dh->previous_version_set) {
+ print join q(, ), @{$vs}
+ }
+ print qq(\n);
+
+Return a L<version set|/VERSION SET> describing each version that needs to be
+"installed" to downgrade to C<< $dh->to_version >>.
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
+
diff --git a/lib/DBIx/Class/DeploymentHandler/Logger.pm b/lib/DBIx/Class/DeploymentHandler/Logger.pm
new file mode 100644
index 0000000..a074a81
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/Logger.pm
@@ -0,0 +1,64 @@
+package DBIx::Class::DeploymentHandler::Logger;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::Logger::VERSION = '0.001004';
+}
+
+use warnings;
+use strict;
+
+use parent 'Log::Contextual::WarnLogger';
+
+# trace works the way we want it already
+
+# sub is_trace { $_[0]->next::method }
+sub is_debug { $_[0]->is_trace || $_[0]->next::method }
+sub is_info { $_[0]->is_debug || $_[0]->next::method }
+
+sub is_warn {
+ my $orig = $_[0]->next::method;
+ return undef if defined $orig && !$orig;
+ return $_[0]->is_info || 1
+}
+
+sub is_error {
+ my $orig = $_[0]->next::method;
+ return undef if defined $orig && !$orig;
+ return $_[0]->is_warn || 1
+}
+
+sub is_fatal {
+ my $orig = $_[0]->next::method;
+ return undef if defined $orig && !$orig;
+ return $_[0]->is_error || 1
+}
+
+sub _log {
+ my $self = shift;
+ my $level = shift;
+ my $message = join( "\n", @_ );
+ $message .= "\n" unless $message =~ /\n$/;
+ warn "[DBICDH] [$level] $message";
+}
+
+1;
+
+__END__
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::Logger
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/DBIx/Class/DeploymentHandler/Manual/CatalystIntro.pod b/lib/DBIx/Class/DeploymentHandler/Manual/CatalystIntro.pod
new file mode 100644
index 0000000..1219cca
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/Manual/CatalystIntro.pod
@@ -0,0 +1,258 @@
+package DBIx::Class::DeploymentHandler::Manual::CatalystIntro
+
+# ABSTRACT: Introduction to using DBIx::Class::DeploymentHandler with a new Catalyst Project
+
+
+__END__
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::Manual::CatalystIntro - Introduction to using DBIx::Class::DeploymentHandler with a new Catalyst Project
+
+=head1 Background
+
+This introduction will use PostgreSQL and L<Catalyst>. Background
+information on using PostgreSQL with Catalyst can be found at
+L<Catalyst::Manual::Tutorial::10_Appendices>. This guide will assume that
+you have some understanding of Catalyst. Please go through the Catalyst
+tutorials first if you have not yet done so.
+
+=head1 Database Setup
+
+Start by creating a user C<catalyst>, with password C<catalyst>
+
+ $ sudo -u postgres createuser -P catalyst
+ Enter password for new role: <catalyst>
+ Enter it again: <catalyst>
+ Shall the new role be a superuser? (y/n) n
+ Shall the new role be allowed to create databases? (y/n) n
+ Shall the new role be allowed to create more new roles? (y/n) n
+
+Then create a new database called C<deploymentintro>
+
+ sudo -u postgres createdb -O catalyst deploymentintro
+
+=head1 Create the project
+
+ $ catalyst.pl DeploymentIntro
+ $ cd DeploymentIntro
+ $ perl Makefile.PL
+
+=head1 Create the Schema
+
+ $ script/deploymentintro_create.pl model DB DBIC::Schema DeploymentIntro::Schema \
+ create=static 'dbi:Pg:dbname=deploymentintro' 'catalyst' 'catalyst' '{ AutoCommit => 1 }'
+
+ $ mkdir -p lib/Schema/Result
+
+Remove the following from C<lib/DeploymentIntro/Model/DB.pm>:
+
+ connect_info => {
+ dsn => 'dbi:Pg:dbname=deploymentintro',
+ user => 'catalyst',
+ password => 'catalyst',
+ AutoCommit => q{1},
+ }
+
+Remove C<deploymentintro.conf> and create a new file called
+C<deploymentintro_local.pl> with the following:
+
+ {
+ name => "DeploymentIntro",
+
+ "Model::DB" => {
+ schema_class => 'DeploymentIntro::Schema',
+
+ connect_info => {
+ dsn => 'dbi:Pg:dbname=deploymentintro',
+ user => 'catalyst',
+ password => 'catalyst',
+ AutoCommit => 1,
+ }
+ }
+ }
+
+Copy the following program into scripts, under the name
+C<deploymentintro_dbicdh.pl>
+
+ #!/usr/bin/env perl
+
+ use strict;
+ use warnings;
+
+ use feature ":5.10";
+
+ use aliased 'DBIx::Class::DeploymentHandler' => 'DH';
+ use FindBin;
+ use lib "$FindBin::Bin/../lib";
+ use DeploymentIntro::Schema;
+ use Config::JFDI;
+
+ my $config = Config::JFDI->new( name => 'DeploymentIntro' );
+ my $config_hash = $config->get;
+ my $connect_info = $config_hash->{"Model::DB"}{"connect_info"};
+ my $schema = DeploymentIntro::Schema->connect($connect_info);
+
+ my $dh = DH->new({
+ schema => $schema,
+ script_directory => "$FindBin::Bin/../dbicdh",
+ databases => 'PostgreSQL',
+ });
+
+ sub install {
+ $dh->prepare_install;
+ $dh->install;
+ }
+
+ sub upgrade {
+ die "Please update the version in Schema.pm"
+ if ( $dh->version_storage->version_rs->search({version => $dh->schema_version})->count );
+
+ die "We only support positive integers for versions around these parts."
+ unless $dh->schema_version =~ /^\d+$/;
+
+ $dh->prepare_deploy;
+ $dh->prepare_upgrade;
+ $dh->upgrade;
+ }
+
+ sub current_version {
+ say $dh->database_version;
+ }
+
+ sub help {
+ say <<'OUT';
+ usage:
+ install
+ upgrade
+ current-version
+ OUT
+ }
+
+ help unless $ARGV[0];
+
+ given ( $ARGV[0] ) {
+ when ('install') { install() }
+ when ('upgrade') { upgrade() }
+ when ('current-version') { current_version() }
+ }
+
+Copy the following files into C<lib/DeploymentIntro/Schema/Result>:
+
+C<Cd.pm>
+
+ package DeploymentIntro::Schema::Result::Cd;
+
+ use strict;
+ use warnings;
+
+ use parent 'DBIx::Class::Core';
+
+ __PACKAGE__->load_components(qw(InflateColumn::DateTime));
+ __PACKAGE__->table('cd');
+
+ __PACKAGE__->add_columns(
+ id => {
+ data_type => 'integer',
+ is_auto_increment => 1,
+ },
+ artist_id => {
+ data_type => 'integer'
+ },
+ title => {
+ data_type => 'text'
+ },
+ );
+
+ __PACKAGE__->set_primary_key('id');
+
+ __PACKAGE__->belongs_to(
+ artist => 'DeploymentIntro::Schema::Result::Artist', 'artist_id' );
+
+ __PACKAGE__->has_many(
+ tracks => 'DeploymentIntro::Schema::Result::Track', 'cd_id' );
+
+ 1;
+
+C<Artist.pm>
+
+ package DeploymentIntro::Schema::Result::Artist;
+
+ use strict;
+ use warnings;
+
+ use parent 'DBIx::Class::Core';
+
+ __PACKAGE__->table('artist');
+
+ __PACKAGE__->add_columns(
+ id => {
+ data_type => 'integer',
+ is_auto_increment => 1,
+ },
+ name => {
+ data_type => 'text'
+ },
+ );
+
+ __PACKAGE__->set_primary_key('id');
+
+ __PACKAGE__->has_many(
+ cds => 'DeploymentIntro::Schema::Result::Cd', 'artist_id' );
+
+ 1;
+
+C<Track.pm>
+
+ package DeploymentIntro::Schema::Result::Track;
+
+ use strict;
+ use warnings;
+
+ use parent 'DBIx::Class::Core';
+
+ __PACKAGE__->table('track');
+
+ __PACKAGE__->add_columns(
+ id => {
+ data_type => 'integer',
+ is_auto_increment => 1,
+ },
+ cd_id => {
+ data_type => 'integer',
+ },
+ title => {
+ data_type => 'text',
+ }
+ );
+
+ __PACKAGE__->set_primary_key('id');
+
+ __PACKAGE__->belongs_to(
+ cd => 'DeploymentIntro::Schema::Result::Cd', 'cd_id' );
+
+ 1;
+
+And then edit C<lib/DeploymentIntro/Schema.pm> and add the following above the
+1 at the bottom
+
+ our $VERSION = 1;
+
+Now it is just a matter of running
+
+ ./script/deploymentintro_dbicdh.pl install
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/DBIx/Class/DeploymentHandler/Manual/Intro.pod b/lib/DBIx/Class/DeploymentHandler/Manual/Intro.pod
new file mode 100644
index 0000000..5795e85
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/Manual/Intro.pod
@@ -0,0 +1,192 @@
+package DBIx::Class::DeploymentHandler::Manual::Intro
+
+# ABSTRACT: Introduction to DBIx::Class::DeploymentHandler
+
+
+__END__
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::Manual::Intro - Introduction to DBIx::Class::DeploymentHandler
+
+=head1 Why is DBIx::Class::DeploymentHandler worth using?
+
+The most obvious reasons for using DBIx::Class::DeploymentHandler are
+that it can run multiple SQL scripts as well as Perl scripts, unlike
+DBIx::Class::Schema::Versioned, which only allows for a single SQL script.
+It is also extremely extensible, and is an opportunity for a break from
+backwards compatibility, so some regrettable decisions are avoided.
+
+=head1 Sample database
+
+Follow L<DBIx::Class::Manual::Intro> except for the parts setting up the
+database. After you are done, You should have the following files.
+
+ MyDatabase/
+ |-- Main
+ | |-- Result
+ | | |-- Artist.pm
+ | | |-- Cd.pm
+ | | `-- Track.pm
+ | `-- ResultSet
+ `-- Main.pm
+
+Add a line like the following in your MyDatabase::Main file:
+
+ our $VERSION = 1;
+
+or if you are using a newer Perl you can use the prettier syntax:
+
+ package MyDatabase::Main 1;
+
+By default DBIx::Class::DeploymentHandler only uses integers for versions,
+this makes versioning much simpler for figuring out what version is next
+(or previous.)
+
+=head1 install.pl
+
+Our first script, C<install.pl> reads our schema file and creates the tables
+in the database.
+
+ #!/usr/bin/env perl
+ use strict;
+ use warnings;
+ use aliased 'DBIx::Class::DeploymentHandler' => 'DH';
+ use FindBin;
+ use lib "$FindBin::Bin/../lib";
+ use MyDatabase::Main;
+ my $schema = MyDatabase::Main->connect('dbi:SQLite:mydb');
+
+ my $dh = DH->new({
+ schema => $schema,
+ script_directory => "$FindBin::Bin/dbicdh",
+ databases => 'SQLite',
+ sql_translator_args => { add_drop_table => 0 },
+ });
+
+ $dh->prepare_install;
+ $dh->install;
+
+=head2 dbicdh - Our migration scripts
+
+Running C<install.pl> should create the following:
+
+ dbicdh/
+ |-- SQLite
+ | `-- deploy
+ | `-- 1
+ | `-- 001-auto.sql
+ `-- _source
+ `-- deploy
+ `-- 1
+ `-- 001-auto.yml
+
+=head3 001-auto.sql
+
+DBIx::Class::DeploymentHandler automatically generates SQL from our schema
+that is suitable for SQLite
+
+=head3 001-auto.yml
+
+This contains all of the raw information about our schema that is then
+translated into the sql.
+
+=head3 Population
+
+To truly take advantage of all DBIx::Class::DeploymentHandler offers, you
+should probably be using it for population. To do that all you need to do
+is create a file called C<dbicdh/_common/install/1/create_artists.pl>:
+
+ sub {
+ my $schema = shift;
+ $schema->resultset('User')->populate([
+ ['name'],
+ ['Marillion'],
+ ['The Moutain Goats'],
+ ['Ladyhawke'],
+ ]);
+ };
+
+=head1 Upgrading
+
+Add a line to MyDatabase/Main/Result/Cd.pm below
+
+ __PACKAGE__->add_columns(qw/ cdid artist title /);
+
+with
+
+ __PACKAGE__->add_column(isbn => { is_nullable => 1 });
+
+Aside: It must be nullable or have a default - otherwise the upgrade will
+fail for logical reasons. To be clear, if you add a column to a database and
+it is not nullable and has no default, what will the existing rows contain
+for that column?
+
+Now you need to modify the schema version in your MyDatabase::Main file to
+tell DBIx::Class::DeploymentHandler the new schema version number. You will
+want to remember the earlier advice about integer version numbers.
+
+ our $VERSION = 2;
+
+So here is our next script, C<upgrade.pl>:
+
+ #!/usr/bin/env perl
+ use strict;
+ use warnings;
+ use aliased 'DBIx::Class::DeploymentHandler' => 'DH';
+ use FindBin;
+ use lib "$FindBin::Bin/../lib";
+ use MyDatabase::Main;
+ my $schema = MyDatabase::Main->connect('dbi:SQLite:mydb');
+
+ my $dh = DH->new({
+ schema => $schema,
+ script_directory => "$FindBin::Bin/dbicdh",
+ databases => 'SQLite',
+ sql_translator_args => { add_drop_table => 0 },
+ });
+
+ $dh->prepare_deploy;
+ $dh->prepare_upgrade({ from_version => 1, to_version => 2});
+ $dh->upgrade;
+
+Our script directory now looks like:
+
+ dbicdh/
+ |-- SQLite
+ | |-- deploy
+ | | |-- 1
+ | | | `-- 001-auto.sql
+ | | `-- 2
+ | | `-- 001-auto.sql
+ | `-- upgrade
+ | `-- 1-2
+ | `-- 001-auto.sql
+ `-- _source
+ `-- deploy
+ |-- 1
+ | `-- 001-auto.yml
+ `-- 2
+ `-- 001-auto.yml
+
+The new C<deploy/001-auto.sql> and C<deploy/001-auto.yml> files are the
+state of the db as at that version. The C<upgrade/1-2/001-auto.sql> file
+is the most interesting one; it is what gets your database from version 1 to 2.
+
+And again, you can create a Perl file like we did previously with the
+deploy stage.
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/DBIx/Class/DeploymentHandler/Types.pm b/lib/DBIx/Class/DeploymentHandler/Types.pm
new file mode 100644
index 0000000..cc0af99
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/Types.pm
@@ -0,0 +1,54 @@
+package DBIx::Class::DeploymentHandler::Types;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::Types::VERSION = '0.001004';
+}
+use strict;
+use warnings;
+
+# ABSTRACT: Types internal to DBIx::Class::DeploymentHandler
+
+use Moose::Util::TypeConstraints;
+subtype 'DBIx::Class::DeploymentHandler::Databases'
+ => as 'ArrayRef[Str]';
+
+coerce 'DBIx::Class::DeploymentHandler::Databases'
+ => from 'Str'
+ => via { [$_] };
+
+subtype 'StrSchemaVersion'
+ => as 'Str'
+ => message {
+ defined $_
+ ? "Schema version (currently '$_') must be a string"
+ : 'Schema version must be defined'
+ };
+
+no Moose::Util::TypeConstraints;
+1;
+
+# vim: ts=2 sw=2 expandtab
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::Types - Types internal to DBIx::Class::DeploymentHandler
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
+
diff --git a/lib/DBIx/Class/DeploymentHandler/VersionHandler/DatabaseToSchemaVersions.pm b/lib/DBIx/Class/DeploymentHandler/VersionHandler/DatabaseToSchemaVersions.pm
new file mode 100644
index 0000000..da44c30
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/VersionHandler/DatabaseToSchemaVersions.pm
@@ -0,0 +1,92 @@
+package DBIx::Class::DeploymentHandler::VersionHandler::DatabaseToSchemaVersions;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::VersionHandler::DatabaseToSchemaVersions::VERSION = '0.001004';
+}
+use Moose;
+
+# ABSTRACT: Go straight from Database to Schema version
+
+use Method::Signatures::Simple;
+
+with 'DBIx::Class::DeploymentHandler::HandlesVersioning';
+
+has schema_version => (
+ isa => 'Str',
+ is => 'ro',
+ required => 1,
+);
+
+has database_version => (
+ isa => 'Str',
+ is => 'ro',
+ required => 1,
+);
+
+has to_version => ( # configuration
+ is => 'ro',
+ isa => 'Str',
+ lazy_build => 1,
+);
+
+sub _build_to_version { $_[0]->schema_version }
+
+has once => (
+ is => 'rw',
+ isa => 'Bool',
+ default => undef,
+);
+
+sub next_version_set {
+ my $self = shift;
+ return undef
+ if $self->once;
+
+ $self->once(!$self->once);
+ return undef
+ if $self->database_version eq $self->to_version;
+ return [$self->database_version, $self->to_version];
+}
+
+sub previous_version_set {
+ my $self = shift;
+ return undef
+ if $self->once;
+
+ $self->once(!$self->once);
+ return undef
+ if $self->database_version eq $self->to_version;
+ return [$self->database_version, $self->to_version];
+}
+
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+# vim: ts=2 sw=2 expandtab
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::VersionHandler::DatabaseToSchemaVersions - Go straight from Database to Schema version
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
+
+
diff --git a/lib/DBIx/Class/DeploymentHandler/VersionHandler/ExplicitVersions.pm b/lib/DBIx/Class/DeploymentHandler/VersionHandler/ExplicitVersions.pm
new file mode 100644
index 0000000..ade4c37
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/VersionHandler/ExplicitVersions.pm
@@ -0,0 +1,135 @@
+package DBIx::Class::DeploymentHandler::VersionHandler::ExplicitVersions;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::VersionHandler::ExplicitVersions::VERSION = '0.001004';
+}
+use Moose;
+
+# ABSTRACT: Define your own list of versions to use for migrations
+
+use Carp 'croak';
+
+with 'DBIx::Class::DeploymentHandler::HandlesVersioning';
+
+has schema_version => (
+ isa => 'Str',
+ is => 'ro',
+ required => 1,
+);
+
+has database_version => (
+ isa => 'Str',
+ is => 'ro',
+ required => 1,
+);
+
+has to_version => (
+ is => 'ro',
+ isa => 'Str',
+ lazy_build => 1,
+);
+
+sub _build_to_version { $_[0]->schema_version }
+
+has ordered_versions => (
+ is => 'ro',
+ isa => 'ArrayRef',
+ required => 1,
+);
+
+has _index_of_versions => (
+ is => 'ro',
+ isa => 'HashRef',
+ lazy_build => 1,
+);
+
+sub _build__index_of_versions {
+ my %ret;
+ my $i = 0;
+ for (@{ $_[0]->ordered_versions }) {
+ $ret{$_} = $i++;
+ }
+ \%ret;
+}
+
+has _version_idx => (
+ is => 'rw',
+ isa => 'Int',
+ lazy_build => 1,
+);
+
+sub _build__version_idx { $_[0]->_index_of_versions->{$_[0]->database_version} }
+
+sub _inc_version_idx { $_[0]->_version_idx($_[0]->_version_idx + 1 ) }
+sub _dec_version_idx { $_[0]->_version_idx($_[0]->_version_idx - 1 ) }
+
+
+sub next_version_set {
+ my $self = shift;
+ if (
+ $self->_index_of_versions->{$self->to_version} <
+ $self->_version_idx
+ ) {
+ croak "you are trying to upgrade and your current version is greater\n".
+ "than the version you are trying to upgrade to. Either downgrade\n".
+ "or update your schema"
+ } elsif ( $self->_version_idx == $self->_index_of_versions->{$self->to_version}) {
+ return undef
+ } else {
+ my $next_idx = $self->_inc_version_idx;
+ return [
+ $self->ordered_versions->[$next_idx - 1],
+ $self->ordered_versions->[$next_idx ],
+ ];
+ }
+}
+
+sub previous_version_set {
+ my $self = shift;
+ if (
+ $self->_index_of_versions->{$self->to_version} >
+ $self->_version_idx
+ ) {
+ croak "you are trying to downgrade and your current version is less\n".
+ "than the version you are trying to downgrade to. Either upgrade\n".
+ "or update your schema"
+ } elsif ( $self->_version_idx == $self->_index_of_versions->{$self->to_version}) {
+ return undef
+ } else {
+ my $next_idx = $self->_dec_version_idx;
+ return [
+ $self->ordered_versions->[$next_idx + 1],
+ $self->ordered_versions->[$next_idx ],
+ ];
+ }
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+# vim: ts=2 sw=2 expandtab
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::VersionHandler::ExplicitVersions - Define your own list of versions to use for migrations
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
+
diff --git a/lib/DBIx/Class/DeploymentHandler/VersionHandler/Monotonic.pm b/lib/DBIx/Class/DeploymentHandler/VersionHandler/Monotonic.pm
new file mode 100644
index 0000000..e3bd0c3
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/VersionHandler/Monotonic.pm
@@ -0,0 +1,101 @@
+package DBIx::Class::DeploymentHandler::VersionHandler::Monotonic;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::VersionHandler::Monotonic::VERSION = '0.001004';
+}
+use Moose;
+
+# ABSTRACT: Obvious version progressions
+
+use Carp 'croak';
+
+with 'DBIx::Class::DeploymentHandler::HandlesVersioning';
+
+has schema_version => (
+ isa => 'Int',
+ is => 'ro',
+ required => 1,
+);
+
+has database_version => (
+ isa => 'Int',
+ is => 'ro',
+ required => 1,
+);
+
+has to_version => (
+ isa => 'Int',
+ is => 'ro',
+ lazy_build => 1,
+);
+
+sub _build_to_version { $_[0]->schema_version }
+
+has _version => (
+ is => 'rw',
+ isa => 'Int',
+ lazy_build => 1,
+);
+
+sub _inc_version { $_[0]->_version($_[0]->_version + 1 ) }
+sub _dec_version { $_[0]->_version($_[0]->_version - 1 ) }
+
+sub _build__version { $_[0]->database_version }
+
+sub previous_version_set {
+ my $self = shift;
+ if ($self->to_version > $self->_version) {
+ croak "you are trying to downgrade and your current version is less\n".
+ "than the version you are trying to downgrade to. Either upgrade\n".
+ "or update your schema"
+ } elsif ( $self->to_version == $self->_version) {
+ return undef
+ } else {
+ $self->_dec_version;
+ return [$self->_version + 1, $self->_version];
+ }
+}
+
+sub next_version_set {
+ my $self = shift;
+ if ($self->to_version < $self->_version) {
+ croak "you are trying to upgrade and your current version is greater\n".
+ "than the version you are trying to upgrade to. Either downgrade\n".
+ "or update your schema"
+ } elsif ( $self->to_version == $self->_version) {
+ return undef
+ } else {
+ $self->_inc_version;
+ return [$self->_version - 1, $self->_version];
+ }
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+# vim: ts=2 sw=2 expandtab
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::VersionHandler::Monotonic - Obvious version progressions
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
+
diff --git a/lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated.pm b/lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated.pm
new file mode 100644
index 0000000..62e5bb1
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated.pm
@@ -0,0 +1,113 @@
+package DBIx::Class::DeploymentHandler::VersionStorage::Deprecated;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::VERSION = '0.001004';
+}
+use Moose;
+use DBIx::Class::DeploymentHandler::Logger;
+use Log::Contextual ':log', -package_logger =>
+ DBIx::Class::DeploymentHandler::Logger->new({
+ env_prefix => 'DBICDH'
+ });
+
+
+# ABSTRACT: (DEPRECATED) Use this if you are stuck in the past
+
+use Method::Signatures::Simple;
+
+has schema => (
+ isa => 'DBIx::Class::Schema',
+ is => 'ro',
+ required => 1,
+);
+
+has version_rs => (
+ isa => 'DBIx::Class::ResultSet',
+ is => 'ro',
+ builder => '_build_version_rs',
+ handles => [qw( database_version version_storage_is_installed )],
+);
+
+with 'DBIx::Class::DeploymentHandler::HandlesVersionStorage';
+
+use DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::VersionResult;
+sub _build_version_rs {
+ $_[0]->schema->register_class(
+ dbix_class_schema_versions =>
+ 'DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::VersionResult'
+ );
+ $_[0]->schema->resultset('dbix_class_schema_versions')
+}
+
+sub add_database_version {
+ # deprecated doesn't support ddl or upgrade_ddl
+ my $version = $_[1]->{version};
+ log_debug { "Adding database version $version" };
+ $_[0]->version_rs->create({ version => $version })
+}
+
+sub delete_database_version {
+ my $version = $_[1]->{version};
+ log_debug { "Deleting database version $version" };
+ $_[0]->version_rs->search({ version => $version})->delete
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+# vim: ts=2 sw=2 expandtab
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::VersionStorage::Deprecated - (DEPRECATED) Use this if you are stuck in the past
+
+=head1 DEPRECATED
+
+I begrudgingly made this module (and other related modules) to keep porting
+from L<DBIx::Class::Schema::Versioned> relatively simple. I will make changes
+to ensure that it works with output from L<DBIx::Class::Schema::Versioned> etc,
+but I will not add any new features to it.
+
+Once I hit major version 1 usage of this module will emit a warning.
+On version 2 it will be removed entirely.
+
+=head1 THIS SUCKS
+
+Here's how to convert from that crufty old Deprecated VersionStorage to a shiny
+new Standard VersionStorage:
+
+ my $s = My::Schema->connect(...);
+ my $dh = DeploymentHandler({
+ schema => $s,
+ });
+
+ $dh->prepare_version_storage_install;
+ $dh->install_version_storage;
+
+ my @versions = $s->{vschema}->resultset('Table')->search(undef, {
+ order_by => 'installed',
+ })->get_column('version')->all;
+
+ $dh->version_storage->add_database_vesion({ version => $_ })
+ for @versions;
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
+
diff --git a/lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated/Component.pm b/lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated/Component.pm
new file mode 100644
index 0000000..7c64ddc
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated/Component.pm
@@ -0,0 +1,76 @@
+package DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::Component;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::Component::VERSION = '0.001004';
+}
+
+# ABSTRACT: (DEPRECATED) Attach this component to your schema to ensure you stay up to date
+
+use strict;
+use warnings;
+
+use Carp 'carp';
+use DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::VersionResult;
+
+sub attach_version_storage {
+ $_[0]->register_class(
+ dbix_class_schema_versions => 'DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::VersionResult'
+ );
+}
+
+sub connection {
+ my $self = shift;
+ $self->next::method(@_);
+
+ $self->attach_version_storage;
+
+ my $args = $_[3] || {};
+
+ unless ( $args->{ignore_version} || $ENV{DBIC_NO_VERSION_CHECK}) {
+ my $versions = $self->resultset('dbix_class_schema_versions');
+
+ if (!$versions->version_storage_is_installed) {
+ carp "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB.\n";
+ } elsif ($versions->database_version ne $self->schema_version) {
+ carp 'Versions out of sync. This is ' . $self->schema_version .
+ ', your database contains version ' . $versions->database_version . ", please call upgrade on your Schema.\n";
+ }
+ }
+
+ return $self;
+}
+
+1;
+
+# vim: ts=2 sw=2 expandtab
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::Component - (DEPRECATED) Attach this component to your schema to ensure you stay up to date
+
+=head1 DEPRECATED
+
+This component has been suplanted by
+L<DBIx::Class::DeploymentHandler::VersionStorage::Standard::Component>.
+In the next major version (1) we will begin issuing a warning on it's use.
+In the major version after that (2) we will remove it entirely.
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
+
diff --git a/lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated/VersionResult.pm b/lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated/VersionResult.pm
new file mode 100644
index 0000000..e43e130
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated/VersionResult.pm
@@ -0,0 +1,66 @@
+package DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::VersionResult;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::VersionResult::VERSION = '0.001004';
+}
+
+# ABSTRACT: (DEPRECATED) The old way to store versions in the database
+
+use strict;
+use warnings;
+
+use parent 'DBIx::Class::Core';
+
+__PACKAGE__->table('dbix_class_schema_versions');
+
+__PACKAGE__->add_columns (
+ version => {
+ data_type => 'VARCHAR',
+ is_nullable => 0,
+ size => '10'
+ },
+ installed => {
+ data_type => 'VARCHAR',
+ is_nullable => 0,
+ size => '20'
+ },
+);
+
+__PACKAGE__->set_primary_key('version');
+
+__PACKAGE__->resultset_class('DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::VersionResultSet');
+
+1;
+
+# vim: ts=2 sw=2 expandtab
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::VersionResult - (DEPRECATED) The old way to store versions in the database
+
+=head1 DEPRECATED
+
+This component has been suplanted by
+L<DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult>.
+In the next major version (1) we will begin issuing a warning on it's use.
+In the major version after that (2) we will remove it entirely.
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
+
diff --git a/lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated/VersionResultSet.pm b/lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated/VersionResultSet.pm
new file mode 100644
index 0000000..4120e94
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated/VersionResultSet.pm
@@ -0,0 +1,99 @@
+package DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::VersionResultSet;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::VersionResultSet::VERSION = '0.001004';
+}
+
+# ABSTRACT: (DEPRECATED) Predefined searches to find what you want from the version storage
+
+use strict;
+use warnings;
+
+use parent 'DBIx::Class::ResultSet';
+
+use Try::Tiny;
+use Time::HiRes 'gettimeofday';
+
+sub version_storage_is_installed {
+ my $self = shift;
+ try { $self->next; 1 } catch { undef }
+}
+
+sub database_version {
+ my $self = shift;
+ $self->search(undef, {
+ order_by => { -desc => 'installed' },
+ rows => 1
+ })->get_column('version')->next;
+}
+
+# this is why it's deprecated guys... Serially.
+sub create {
+ my $self = shift;
+ my $args = shift;
+
+ my @tm = gettimeofday();
+ my @dt = gmtime ($tm[0]);
+
+ $self->next::method({
+ %{$args},
+ installed => sprintf("v%04d%02d%02d_%02d%02d%02d.%03.0f",
+ $dt[5] + 1900,
+ $dt[4] + 1,
+ $dt[3],
+ $dt[2],
+ $dt[1],
+ $dt[0],
+ $tm[1] / 1000, # convert to millisecs, format as up/down rounded int above
+ ),
+ });
+}
+
+1;
+
+# vim: ts=2 sw=2 expandtab
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::VersionResultSet - (DEPRECATED) Predefined searches to find what you want from the version storage
+
+=head1 DEPRECATED
+
+This component has been suplanted by
+L<DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResultSet>.
+In the next major version (1) we will begin issuing a warning on it's use.
+In the major version after that (2) we will remove it entirely.
+
+=head1 METHODS
+
+=head2 version_storage_is_installed
+
+True if (!!!) the version storage has been installed
+
+=head2 database_version
+
+The version of the database
+
+=head2 create
+
+Overridden to default C<installed> to the current time. (take a look, it's yucky)
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
+
diff --git a/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard.pm b/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard.pm
new file mode 100644
index 0000000..1b6915b
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard.pm
@@ -0,0 +1,81 @@
+package DBIx::Class::DeploymentHandler::VersionStorage::Standard;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::VersionStorage::Standard::VERSION = '0.001004';
+}
+use Moose;
+use DBIx::Class::DeploymentHandler::Logger;
+use Log::Contextual ':log', -package_logger =>
+ DBIx::Class::DeploymentHandler::Logger->new({
+ env_prefix => 'DBICDH'
+ });
+
+# ABSTRACT: Version storage that does the normal stuff
+
+use Method::Signatures::Simple;
+use DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult;
+
+has schema => (
+ isa => 'DBIx::Class::Schema',
+ is => 'ro',
+ required => 1,
+);
+
+has version_rs => (
+ isa => 'DBIx::Class::ResultSet',
+ is => 'ro',
+ builder => '_build_version_rs',
+ handles => [qw( database_version version_storage_is_installed )],
+);
+
+with 'DBIx::Class::DeploymentHandler::HandlesVersionStorage';
+
+sub _build_version_rs {
+ $_[0]->schema->register_class(
+ __VERSION =>
+ 'DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult'
+ );
+ $_[0]->schema->resultset('__VERSION')
+}
+
+sub add_database_version {
+ my $version = $_[1]->{version};
+ log_debug { "Adding database version $version" };
+ $_[0]->version_rs->create($_[1])
+}
+
+sub delete_database_version {
+ my $version = $_[1]->{version};
+ log_debug { "Deleting database version $version" };
+ $_[0]->version_rs->search({ version => $version})->delete
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+# vim: ts=2 sw=2 expandtab
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::VersionStorage::Standard - Version storage that does the normal stuff
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
+
diff --git a/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard/Component.pm b/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard/Component.pm
new file mode 100644
index 0000000..5658210
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard/Component.pm
@@ -0,0 +1,69 @@
+package DBIx::Class::DeploymentHandler::VersionStorage::Standard::Component;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::VersionStorage::Standard::Component::VERSION = '0.001004';
+}
+
+# ABSTRACT: Attach this component to your schema to ensure you stay up to date
+
+use strict;
+use warnings;
+
+use Carp 'carp';
+use DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult;
+
+sub attach_version_storage {
+ $_[0]->register_class(
+ __VERSION => 'DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult'
+ );
+}
+
+sub connection {
+ my $self = shift;
+ $self->next::method(@_);
+
+ $self->attach_version_storage;
+
+ my $args = $self->storage->_dbic_connect_attributes;
+
+ unless ( $args->{ignore_version} || $ENV{DBIC_NO_VERSION_CHECK}) {
+ my $versions = $self->resultset('__VERSION');
+
+ if (!$versions->version_storage_is_installed) {
+ carp "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB.\n";
+ } elsif ($versions->database_version ne $self->schema_version) {
+ carp 'Versions out of sync. This is ' . $self->schema_version .
+ ', your database contains version ' . $versions->database_version . ", please call upgrade on your Schema.\n";
+ }
+ }
+
+ return $self;
+}
+
+1;
+
+# vim: ts=2 sw=2 expandtab
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::VersionStorage::Standard::Component - Attach this component to your schema to ensure you stay up to date
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
+
diff --git a/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard/VersionResult.pm b/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard/VersionResult.pm
new file mode 100644
index 0000000..63583ca
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard/VersionResult.pm
@@ -0,0 +1,67 @@
+package DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult::VERSION = '0.001004';
+}
+
+# ABSTRACT: The typical way to store versions in the database
+
+use strict;
+use warnings;
+
+use parent 'DBIx::Class::Core';
+
+__PACKAGE__->table('dbix_class_deploymenthandler_versions');
+
+__PACKAGE__->add_columns (
+ id => {
+ data_type => 'int',
+ is_auto_increment => 1,
+ },
+ version => {
+ data_type => 'varchar',
+ # size needs to be at least
+ # 40 to support SHA1 versions
+ size => '50'
+ },
+ ddl => {
+ data_type => 'text',
+ is_nullable => 1,
+ },
+ upgrade_sql => {
+ data_type => 'text',
+ is_nullable => 1,
+ },
+);
+
+__PACKAGE__->set_primary_key('id');
+__PACKAGE__->add_unique_constraint(['version']);
+__PACKAGE__->resultset_class('DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResultSet');
+
+1;
+
+# vim: ts=2 sw=2 expandtab
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult - The typical way to store versions in the database
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
+
diff --git a/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard/VersionResultSet.pm b/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard/VersionResultSet.pm
new file mode 100644
index 0000000..53d4b11
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard/VersionResultSet.pm
@@ -0,0 +1,65 @@
+package DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResultSet;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResultSet::VERSION = '0.001004';
+}
+
+# ABSTRACT: Predefined searches to find what you want from the version storage
+
+use strict;
+use warnings;
+
+use parent 'DBIx::Class::ResultSet';
+
+use Try::Tiny;
+
+sub version_storage_is_installed {
+ my $self = shift;
+ try { $self->next; 1 } catch { undef }
+}
+
+sub database_version {
+ my $self = shift;
+ $self->search(undef, {
+ order_by => { -desc => 'id' },
+ rows => 1
+ })->get_column('version')->next;
+}
+
+1;
+
+# vim: ts=2 sw=2 expandtab
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResultSet - Predefined searches to find what you want from the version storage
+
+=head1 METHODS
+
+=head2 version_storage_is_installed
+
+True if (!!!) the version storage has been installed
+
+=head2 database_version
+
+The version of the database
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
+
diff --git a/lib/DBIx/Class/DeploymentHandler/WithApplicatorDumple.pm b/lib/DBIx/Class/DeploymentHandler/WithApplicatorDumple.pm
new file mode 100644
index 0000000..a9163ff
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/WithApplicatorDumple.pm
@@ -0,0 +1,97 @@
+package DBIx::Class::DeploymentHandler::WithApplicatorDumple;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::WithApplicatorDumple::VERSION = '0.001004';
+}
+use MooseX::Role::Parameterized;
+use Class::MOP;
+use namespace::autoclean;
+
+# this is at least a little ghetto and not super well
+# thought out. Take a look at the following at some
+# point to clean it all up:
+#
+# http://search.cpan.org/~jjnapiork/MooseX-Role-BuildInstanceOf-0.06/lib/MooseX/Role/BuildInstanceOf.pm
+# http://github.com/rjbs/role-subsystem/blob/master/lib/Role/Subsystem.pm
+
+parameter interface_role => (
+ isa => 'Str',
+ required => 1,
+);
+
+parameter class_name => (
+ isa => 'Str',
+ required => 1,
+);
+
+parameter delegate_name => (
+ isa => 'Str',
+ required => 1,
+);
+
+parameter attributes_to_copy => (
+ isa => 'ArrayRef[Str]',
+ default => sub {[]},
+);
+
+parameter attributes_to_assume => (
+ isa => 'ArrayRef[Str]',
+ default => sub {[]},
+);
+
+role {
+ my $p = shift;
+
+ my $class_name = $p->class_name;
+
+ Class::MOP::load_class($class_name);
+
+ my $meta = Class::MOP::class_of($class_name);
+
+ has $_->name => %{ $_->clone }
+ for grep { $_ } map $meta->find_attribute_by_name($_), @{ $p->attributes_to_copy };
+
+ has $p->delegate_name => (
+ is => 'ro',
+ lazy_build => 1,
+ does => $p->interface_role,
+ handles => $p->interface_role,
+ );
+
+ method '_build_'.$p->delegate_name => sub {
+ my $self = shift;
+
+ $class_name->new({
+ map { $_ => $self->$_ }
+ @{ $p->attributes_to_assume },
+ @{ $p->attributes_to_copy },
+ })
+ };
+};
+
+1;
+
+# vim: ts=2 sw=2 expandtab
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::WithApplicatorDumple
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
diff --git a/lib/DBIx/Class/DeploymentHandler/WithReasonableDefaults.pm b/lib/DBIx/Class/DeploymentHandler/WithReasonableDefaults.pm
new file mode 100644
index 0000000..c8f6190
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/WithReasonableDefaults.pm
@@ -0,0 +1,102 @@
+package DBIx::Class::DeploymentHandler::WithReasonableDefaults;
+BEGIN {
+ $DBIx::Class::DeploymentHandler::WithReasonableDefaults::VERSION = '0.001004';
+}
+use Moose::Role;
+
+# ABSTRACT: Make default arguments to a few methods sensible
+
+requires qw( prepare_upgrade prepare_downgrade database_version schema_version );
+
+around prepare_upgrade => sub {
+ my $orig = shift;
+ my $self = shift;
+ my $args = shift || {};
+
+ $args->{from_version} ||= $self->database_version;
+ $args->{to_version} ||= $self->schema_version;
+ $args->{version_set} ||= [$args->{from_version}, $args->{to_version}];
+
+ $self->$orig($args);
+};
+
+
+around prepare_downgrade => sub {
+ my $orig = shift;
+ my $self = shift;
+
+ my $args = shift || {};
+
+ $args->{from_version} ||= $self->database_version;
+ $args->{to_version} ||= $self->schema_version;
+ $args->{version_set} ||= [$args->{from_version}, $args->{to_version}];
+
+ $self->$orig($args);
+};
+
+around install_resultsource => sub {
+ my $orig = shift;
+ my $self = shift;
+ my $source = shift;
+ my $version = shift || $self->to_version;
+
+ $self->$orig($source, $version);
+};
+
+1;
+
+
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::DeploymentHandler::WithReasonableDefaults - Make default arguments to a few methods sensible
+
+=head1 CONVENIENCE
+
+The whole point of this role is to set defaults for arguments of various
+methods. It's a little awesome.
+
+=head1 METHODS
+
+=head2 prepare_upgrade
+
+Defaulted args:
+
+ my $from_version = $self->database_version;
+ my $to_version = $self->schema_version;
+ my $version_set = [$from_version, $to_version];
+
+=head2 prepare_downgrade
+
+Defaulted args:
+
+ my $from_version = $self->database_version;
+ my $to_version = $self->schema_version;
+ my $version_set = [$to_version];
+
+=head2 install_resultsource
+
+Defaulted args:
+
+ my $version = $self->to_version;
+
+=head1 AUTHOR
+
+Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
+
+__END__
+
+vim: ts=2 sw=2 expandtab
+
diff --git a/t/02-instantiation-no-ddl.t b/t/02-instantiation-no-ddl.t
new file mode 100644
index 0000000..1948051
--- /dev/null
+++ b/t/02-instantiation-no-ddl.t
@@ -0,0 +1,163 @@
+#!perl
+
+use strict;
+use warnings;
+
+use lib 't/lib';
+use DBICDHTest;
+use DBIx::Class::DeploymentHandler;
+use aliased 'DBIx::Class::DeploymentHandler', 'DH';
+
+use File::Path 'remove_tree';
+use Test::More;
+use Test::Exception;
+use DBI;
+
+DBICDHTest::ready;
+my $dbh = DBI->connect('dbi:SQLite::memory:');
+my @connection = (sub { $dbh }, { ignore_version => 1 });
+my $sql_dir = 't/sql';
+
+VERSION1: {
+ use_ok 'DBICVersion_v1';
+ my $s = DBICVersion::Schema->connect(@connection);
+ $DBICVersion::Schema::VERSION = 1;
+ ok($s, 'DBICVersion::Schema 1 instantiates correctly');
+ my $handler = DH->new({
+ ignore_ddl => 1,
+ script_directory => $sql_dir,
+ schema => $s,
+ databases => [],
+ sql_translator_args => { add_drop_table => 0 },
+ });
+
+ ok($handler, 'DBIx::Class::DeploymentHandler w/1 instantiates correctly');
+
+ my $version = $s->schema_version;
+ $handler->prepare_install;
+
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ })
+ } 'schema not deployed';
+ $handler->install;
+ dies_ok {
+ $handler->install;
+ } 'cannot install twice';
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ })
+ } 'schema is deployed';
+}
+
+VERSION2: {
+ use_ok 'DBICVersion_v2';
+ my $s = DBICVersion::Schema->connect(@connection);
+ $DBICVersion::Schema::VERSION = 2;
+ ok($s, 'DBICVersion::Schema 2 instantiates correctly');
+ my $handler = DH->new({
+ ignore_ddl => 1,
+ script_directory => $sql_dir,
+ schema => $s,
+ databases => [],
+ });
+
+ ok($handler, 'DBIx::Class::DeploymentHandler w/2 instantiates correctly');
+
+ my $version = $s->schema_version();
+ $handler->prepare_install;
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema not deployed';
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema not uppgrayyed';
+ $handler->upgrade;
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema is deployed';
+}
+
+VERSION3: {
+ use_ok 'DBICVersion_v3';
+ my $s = DBICVersion::Schema->connect(@connection);
+ $DBICVersion::Schema::VERSION = 3;
+ ok($s, 'DBICVersion::Schema 3 instantiates correctly');
+ my $handler = DH->new({
+ ignore_ddl => 1,
+ script_directory => $sql_dir,
+ schema => $s,
+ databases => [],
+ });
+
+ ok($handler, 'DBIx::Class::DeploymentHandler w/3 instantiates correctly');
+
+ my $version = $s->schema_version();
+ $handler->prepare_install;
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ biff => 'frew',
+ })
+ } 'schema not deployed';
+ $handler->upgrade;
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ biff => 'frew',
+ })
+ } 'schema is deployed';
+}
+
+DOWN2: {
+ use_ok 'DBICVersion_v4';
+ my $s = DBICVersion::Schema->connect(@connection);
+ $DBICVersion::Schema::VERSION = 2;
+ ok($s, 'DBICVersion::Schema 2 instantiates correctly');
+ my $handler = DH->new({
+ ignore_ddl => 1,
+ script_directory => $sql_dir,
+ schema => $s,
+ databases => [],
+ });
+
+ ok($handler, 'DBIx::Class::DeploymentHandler w/2 instantiates correctly');
+
+ my $version = $s->schema_version();
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ biff => 'frew',
+ })
+ } 'schema at version 3';
+ $handler->downgrade;
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ biff => 'frew',
+ })
+ } 'schema not at version 3';
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema is at version 2';
+}
+
+done_testing;
diff --git a/t/02-instantiation-wo-component.t b/t/02-instantiation-wo-component.t
new file mode 100644
index 0000000..360335f
--- /dev/null
+++ b/t/02-instantiation-wo-component.t
@@ -0,0 +1,162 @@
+#!perl
+
+use strict;
+use warnings;
+
+use lib 't/no-component-lib';
+use DBICDHTest;
+use DBIx::Class::DeploymentHandler;
+use aliased 'DBIx::Class::DeploymentHandler', 'DH';
+
+use File::Path 'remove_tree';
+use Test::More;
+use Test::Exception;
+
+DBICDHTest::ready;
+
+my $dbh = DBI->connect('dbi:SQLite::memory:');
+my @connection = (sub { $dbh }, { ignore_version => 1 });
+my $sql_dir = 't/sql';
+
+VERSION1: {
+ use_ok 'DBICVersion_v1';
+ my $s = DBICVersion::Schema->connect(@connection);
+ $DBICVersion::Schema::VERSION = 1;
+ ok($s, 'DBICVersion::Schema 1 instantiates correctly');
+ my $handler = DH->new({
+ script_directory => $sql_dir,
+ schema => $s,
+ databases => 'SQLite',
+ sql_translator_args => { add_drop_table => 0 },
+ });
+
+ ok($handler, 'DBIx::Class::DeploymentHandler w/1 instantiates correctly');
+
+ my $version = $s->schema_version;
+ $handler->prepare_install;
+
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ })
+ } 'schema not deployed';
+ $handler->install;
+ dies_ok {
+ $handler->install;
+ } 'cannot install twice';
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ })
+ } 'schema is deployed';
+}
+
+VERSION2: {
+ use_ok 'DBICVersion_v2';
+ my $s = DBICVersion::Schema->connect(@connection);
+ $DBICVersion::Schema::VERSION = 2;
+ ok($s, 'DBICVersion::Schema 2 instantiates correctly');
+ my $handler = DH->new({
+ script_directory => $sql_dir,
+ schema => $s,
+ databases => 'SQLite',
+ });
+
+ ok($handler, 'DBIx::Class::DeploymentHandler w/2 instantiates correctly');
+
+ my $version = $s->schema_version();
+ $handler->prepare_install;
+ $handler->prepare_upgrade({ from_version => 1, to_version => $version });
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema not deployed';
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema not uppgrayyed';
+ $handler->upgrade;
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema is deployed';
+}
+
+VERSION3: {
+ use_ok 'DBICVersion_v3';
+ my $s = DBICVersion::Schema->connect(@connection);
+ $DBICVersion::Schema::VERSION = 3;
+ ok($s, 'DBICVersion::Schema 3 instantiates correctly');
+ my $handler = DH->new({
+ script_directory => $sql_dir,
+ schema => $s,
+ databases => 'SQLite',
+ });
+
+ ok($handler, 'DBIx::Class::DeploymentHandler w/3 instantiates correctly');
+
+ my $version = $s->schema_version();
+ $handler->prepare_install;
+ $handler->prepare_upgrade({ from_version => 2, to_version => $version });
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ biff => 'frew',
+ })
+ } 'schema not deployed';
+ $handler->upgrade;
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ biff => 'frew',
+ })
+ } 'schema is deployed';
+}
+
+DOWN2: {
+ use_ok 'DBICVersion_v4';
+ my $s = DBICVersion::Schema->connect(@connection);
+ $DBICVersion::Schema::VERSION = 2;
+ ok($s, 'DBICVersion::Schema 2 instantiates correctly');
+ my $handler = DH->new({
+ script_directory => $sql_dir,
+ schema => $s,
+ databases => 'SQLite',
+ });
+
+ ok($handler, 'DBIx::Class::DeploymentHandler w/2 instantiates correctly');
+
+ my $version = $s->schema_version();
+ $handler->prepare_downgrade({ from_version => 3, to_version => $version });
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ biff => 'frew',
+ })
+ } 'schema at version 3';
+ $handler->downgrade;
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ biff => 'frew',
+ })
+ } 'schema not at version 3';
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema is at version 2';
+}
+
+done_testing;
diff --git a/t/02-instantiation.t b/t/02-instantiation.t
new file mode 100644
index 0000000..04a20f4
--- /dev/null
+++ b/t/02-instantiation.t
@@ -0,0 +1,162 @@
+#!perl
+
+use strict;
+use warnings;
+
+use lib 't/lib';
+use DBICDHTest;
+use DBIx::Class::DeploymentHandler;
+use aliased 'DBIx::Class::DeploymentHandler', 'DH';
+
+use File::Path 'remove_tree';
+use Test::More;
+use Test::Exception;
+
+DBICDHTest::ready;
+
+my $dbh = DBI->connect('dbi:SQLite::memory:');
+my @connection = (sub { $dbh }, { ignore_version => 1 });
+my $sql_dir = 't/sql';
+
+VERSION1: {
+ use_ok 'DBICVersion_v1';
+ my $s = DBICVersion::Schema->connect(@connection);
+ $DBICVersion::Schema::VERSION = 1;
+ ok($s, 'DBICVersion::Schema 1 instantiates correctly');
+ my $handler = DH->new({
+ script_directory => $sql_dir,
+ schema => $s,
+ databases => 'SQLite',
+ sql_translator_args => { add_drop_table => 0 },
+ });
+
+ ok($handler, 'DBIx::Class::DeploymentHandler w/1 instantiates correctly');
+
+ my $version = $s->schema_version;
+ $handler->prepare_install;
+
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ })
+ } 'schema not deployed';
+ $handler->install;
+ dies_ok {
+ $handler->install;
+ } 'cannot install twice';
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ })
+ } 'schema is deployed';
+}
+
+VERSION2: {
+ use_ok 'DBICVersion_v2';
+ my $s = DBICVersion::Schema->connect(@connection);
+ $DBICVersion::Schema::VERSION = 2;
+ ok($s, 'DBICVersion::Schema 2 instantiates correctly');
+ my $handler = DH->new({
+ script_directory => $sql_dir,
+ schema => $s,
+ databases => 'SQLite',
+ });
+
+ ok($handler, 'DBIx::Class::DeploymentHandler w/2 instantiates correctly');
+
+ my $version = $s->schema_version();
+ $handler->prepare_install;
+ $handler->prepare_upgrade({ from_version => 1, to_version => $version} );
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema not deployed';
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema not uppgrayyed';
+ $handler->upgrade;
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema is deployed';
+}
+
+VERSION3: {
+ use_ok 'DBICVersion_v3';
+ my $s = DBICVersion::Schema->connect(@connection);
+ $DBICVersion::Schema::VERSION = 3;
+ ok($s, 'DBICVersion::Schema 3 instantiates correctly');
+ my $handler = DH->new({
+ script_directory => $sql_dir,
+ schema => $s,
+ databases => 'SQLite',
+ });
+
+ ok($handler, 'DBIx::Class::DeploymentHandler w/3 instantiates correctly');
+
+ my $version = $s->schema_version();
+ $handler->prepare_install;
+ $handler->prepare_upgrade({ from_version => 2, to_version => $version });
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ biff => 'frew',
+ })
+ } 'schema not deployed';
+ $handler->upgrade;
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ biff => 'frew',
+ })
+ } 'schema is deployed';
+}
+
+DOWN2: {
+ use_ok 'DBICVersion_v4';
+ my $s = DBICVersion::Schema->connect(@connection);
+ $DBICVersion::Schema::VERSION = 2;
+ ok($s, 'DBICVersion::Schema 2 instantiates correctly');
+ my $handler = DH->new({
+ script_directory => $sql_dir,
+ schema => $s,
+ databases => 'SQLite',
+ });
+
+ ok($handler, 'DBIx::Class::DeploymentHandler w/2 instantiates correctly');
+
+ my $version = $s->schema_version();
+ $handler->prepare_downgrade({ from_version => 3, to_version => $version });
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ biff => 'frew',
+ })
+ } 'schema at version 3';
+ $handler->downgrade;
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ biff => 'frew',
+ })
+ } 'schema not at version 3';
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema is at version 2';
+}
+
+done_testing;
diff --git a/t/03-deprecated.t b/t/03-deprecated.t
new file mode 100644
index 0000000..f89950e
--- /dev/null
+++ b/t/03-deprecated.t
@@ -0,0 +1,123 @@
+#!perl
+
+use strict;
+use warnings;
+
+use lib 't/lib';
+use DBICDHTest;
+use aliased 'DBIx::Class::DeploymentHandler::Deprecated';
+
+use File::Path 'remove_tree';
+use Test::More;
+use Test::Exception;
+
+DBICDHTest::ready;
+
+my $dbh = DBI->connect('dbi:SQLite::memory:');
+my @connection = (sub { $dbh }, { ignore_version => 1 });
+my $sql_dir = 't/sql';
+
+VERSION1: {
+ use_ok 'DBICVersion_v1';
+ my $s = DBICVersion::Schema->connect(@connection);
+ is $s->schema_version, '1.0', 'schema version is at 1.0';
+ ok($s, 'DBICVersion::Schema 1.0 instantiates correctly');
+ my $handler = Deprecated->new({
+ script_directory => $sql_dir,
+ schema => $s,
+ databases => 'SQLite',
+ sql_translator_args => { add_drop_table => 0 },
+ });
+
+ ok($handler, 'DBIx::Class::DeploymentHandler w/1.0 instantiates correctly');
+
+ my $version = $s->schema_version();
+ $handler->prepare_deploy();
+
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ })
+ } 'schema not deployed';
+ $handler->install;
+ dies_ok {
+ $handler->install;
+ } 'cannot install twice';
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ })
+ } 'schema is deployed';
+}
+
+VERSION2: {
+ use_ok 'DBICVersion_v2';
+ my $s = DBICVersion::Schema->connect(@connection);
+ is $s->schema_version, '2.0', 'schema version is at 2.0';
+ ok($s, 'DBICVersion::Schema 2.0 instantiates correctly');
+ my $handler = Deprecated->new({
+ script_directory => $sql_dir,
+ schema => $s,
+ databases => 'SQLite',
+ });
+
+ ok($handler, 'DBIx::Class::DeploymentHandler w/2.0 instantiates correctly');
+
+ my $version = $s->schema_version();
+ $handler->prepare_deploy();
+ $handler->prepare_upgrade({ from_version => '1.0', to_version => $version });
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema not deployed';
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema not uppgrayyed';
+ $handler->upgrade;
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema is deployed';
+}
+
+VERSION3: {
+ use_ok 'DBICVersion_v3';
+ my $s = DBICVersion::Schema->connect(@connection);
+ is $s->schema_version, '3.0', 'schema version is at 3.0';
+ ok($s, 'DBICVersion::Schema 3.0 instantiates correctly');
+ my $handler = Deprecated->new({
+ script_directory => $sql_dir,
+ schema => $s,
+ databases => 'SQLite',
+ });
+
+ ok($handler, 'DBIx::Class::DeploymentHandler w/3.0 instantiates correctly');
+
+ my $version = $s->schema_version();
+ $handler->prepare_deploy;
+ $handler->prepare_upgrade({ from_version => '2.0', to_version => $version });
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ biff => 'frew',
+ })
+ } 'schema not deployed';
+ $handler->upgrade;
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ biff => 'frew',
+ })
+ } 'schema is deployed';
+}
+
+done_testing;
diff --git a/t/04-preconnect.t b/t/04-preconnect.t
new file mode 100644
index 0000000..9d9cded
--- /dev/null
+++ b/t/04-preconnect.t
@@ -0,0 +1,40 @@
+#!perl
+
+use strict;
+use warnings;
+
+use lib 't/lib';
+use DBICDHTest;
+use DBIx::Class::DeploymentHandler;
+use aliased 'DBIx::Class::DeploymentHandler', 'DH';
+
+use File::Path qw(remove_tree mkpath);
+use Test::More;
+use Test::Exception;
+
+DBICDHTest::ready;
+
+my $db = 'dbi:SQLite::memory:';
+my @connection = ($db, '', '', { ignore_version => 1, on_connect_do => sub { die }});
+my $sql_dir = 't/sql';
+
+VERSION1: {
+ use_ok 'DBICVersion_v1';
+ my $s = DBICVersion::Schema->connect(@connection);
+ $DBICVersion::Schema::VERSION = 1;
+ ok($s, 'DBICVersion::Schema 1 instantiates correctly');
+ ok !$s->storage->connected, 'creating schema did not connect';
+ my $handler = DH->new({
+ script_directory => $sql_dir,
+ schema => $s,
+ databases => 'SQLite',
+ sql_translator_args => { add_drop_table => 0 },
+ });
+ ok !$s->storage->connected, 'creating handler did not connect';
+ ok($handler, 'DBIx::Class::DeploymentHandler w/1 instantiates correctly');
+
+ mkpath('t/sql/SQLite/initialize/1');
+ $handler->initialize({ version => 1, storage_type => 'SQLite' });
+ ok !$s->storage->connected, 'creating schema did not connect';
+}
+done_testing;
diff --git a/t/bugs/01-emailed-bug-01.t b/t/bugs/01-emailed-bug-01.t
new file mode 100644
index 0000000..1303f04
--- /dev/null
+++ b/t/bugs/01-emailed-bug-01.t
@@ -0,0 +1,44 @@
+#!perl
+
+use strict;
+use warnings;
+
+use lib 't/lib';
+use DBICDHTest;
+use DBIx::Class::DeploymentHandler;
+use aliased 'DBIx::Class::DeploymentHandler', 'DH';
+
+use File::Path 'remove_tree';
+use Test::More;
+use Test::Exception;
+
+DBICDHTest::ready;
+
+my $dbh = DBI->connect('dbi:SQLite::memory:');
+my @connection = (sub { $dbh }, { ignore_version => 1 });
+my $sql_dir = 't/sql';
+
+use_ok 'DBICVersion_v1';
+my $s = DBICVersion::Schema->connect(@connection);
+$DBICVersion::Schema::VERSION = 1;
+ok($s, 'DBICVersion::Schema 1 instantiates correctly');
+
+my $dh = DH->new({
+ script_directory => $sql_dir,
+ schema => $s,
+ databases => 'SQLite',
+ sql_translator_args => { add_drop_table => 0 },
+});
+
+ok($dh, 'DBIx::Class::DeploymentHandler w/1 instantiates correctly');
+$dh->prepare_version_storage_install;
+
+
+dies_ok { $s->resultset('__VERSION')->first->version } 'version_storage not installed';
+$dh->install_version_storage;
+
+$dh->add_database_version( { version => $s->schema_version } );
+
+lives_ok { $s->resultset('__VERSION')->first->version } 'version_storage installed';
+
+done_testing;
diff --git a/t/deploy_methods/sql_translator.t b/t/deploy_methods/sql_translator.t
new file mode 100644
index 0000000..c0dba04
--- /dev/null
+++ b/t/deploy_methods/sql_translator.t
@@ -0,0 +1,247 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+use lib 't/lib';
+use DBICDHTest;
+use aliased 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator';
+use File::Spec::Functions;
+use File::Path qw(rmtree mkpath);
+
+my $dbh = DBI->connect('dbi:SQLite::memory:');
+my @connection = (sub { $dbh }, { ignore_version => 1 });
+my $sql_dir = 't/sql';
+
+DBICDHTest::ready;
+
+VERSION1: {
+ use_ok 'DBICVersion_v1';
+ my $s = DBICVersion::Schema->connect(@connection);
+ my $dm = Translator->new({
+ schema => $s,
+ script_directory => $sql_dir,
+ databases => ['SQLite'],
+ sql_translator_args => { add_drop_table => 0 },
+ });
+
+ ok( $dm, 'DBIC::DH::DM::SQL::Translator gets instantiated correctly' );
+
+ $dm->prepare_deploy;
+
+ mkpath(catfile(qw( t sql SQLite initialize 1.0 )));
+ open my $prerun, '>',
+ catfile(qw( t sql SQLite initialize 1.0 003-semiautomatic.pl ));
+ print {$prerun} "sub {use File::Touch; touch(q(foobar));}";
+ close $prerun;
+ $dm->initialize({ version => '1.0' });
+
+ ok -e 'foobar';
+
+ dies_ok {$dm->prepare_deploy} 'prepare_deploy dies if you run it twice' ;
+
+ ok(
+ -f catfile(qw( t sql SQLite deploy 1.0 001-auto.sql )),
+ '1.0 schema gets generated properly'
+ );
+
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ })
+ } 'schema not deployed';
+
+ $dm->deploy;
+
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ })
+ } 'schema is deployed';
+}
+
+VERSION2: {
+ use_ok 'DBICVersion_v2';
+ my $s = DBICVersion::Schema->connect(@connection);
+ my $dm = Translator->new({
+ schema => $s,
+ script_directory => $sql_dir,
+ databases => ['SQLite'],
+ sql_translator_args => { add_drop_table => 0 },
+ txn_wrap => 1,
+ });
+
+ ok( $dm, 'DBIC::DH::SQL::Translator w/2.0 instantiates correctly');
+
+ my $version = $s->schema_version();
+ $dm->prepare_deploy;
+ ok(
+ -f catfile(qw( t sql SQLite deploy 2.0 001-auto.sql )),
+ '2.0 schema gets generated properly'
+ );
+ mkpath(catfile(qw( t sql SQLite upgrade 1.0-2.0 )));
+ $dm->prepare_upgrade({
+ from_version => '1.0',
+ to_version => '2.0',
+ version_set => [qw(1.0 2.0)]
+ });
+
+ {
+ my $warned = 0;
+ local $SIG{__WARN__} = sub{$warned = 1};
+ $dm->prepare_upgrade({
+ from_version => '0.0',
+ to_version => '1.0',
+ version_set => [qw(0.0 1.0)]
+ });
+ ok( $warned, 'prepare_upgrade with a bogus preversion warns' );
+ }
+ ok(
+ -f catfile(qw( t sql SQLite upgrade 1.0-2.0 001-auto.sql )),
+ '1.0-2.0 diff gets generated properly and default start and end versions get set'
+ );
+ mkpath(catfile(qw( t sql SQLite downgrade 2.0-1.0 )));
+ $dm->prepare_downgrade({
+ from_version => $version,
+ to_version => '1.0',
+ version_set => [$version, '1.0']
+ });
+ ok(
+ -f catfile(qw( t sql SQLite downgrade 2.0-1.0 001-auto.sql )),
+ '2.0-1.0 diff gets generated properly'
+ );
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema not deployed';
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema not uppgrayyed';
+
+ mkpath catfile(qw( t sql _common upgrade 1.0-2.0 ));
+ open my $common, '>',
+ catfile(qw( t sql _common upgrade 1.0-2.0 002-semiautomatic.sql ));
+ print {$common} qq<INSERT INTO Foo (bar, baz) VALUES ("hello", "world");\n\n>;
+ close $common;
+
+ open my $common_pl, '>',
+ catfile(qw( t sql _common upgrade 1.0-2.0 003-semiautomatic.pl ));
+ print {$common_pl} q|
+ sub {
+ my $schema = shift;
+ $schema->resultset('Foo')->create({
+ bar => 'goodbye',
+ baz => 'blue skies',
+ })
+ }
+ |;
+ close $common_pl;
+
+ $dm->upgrade_single_step({ version_set => [qw( 1.0 2.0 )] });
+ is( $s->resultset('Foo')->search({
+ bar => 'hello',
+ baz => 'world',
+ })->count, 1, '_common migration got run');
+ is( $s->resultset('Foo')->search({
+ bar => 'goodbye',
+ #baz => 'blue skies',
+ })->count, 1, '_common perl migration got run');
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema is deployed';
+ $dm->downgrade_single_step({ version_set => [qw( 2.0 1.0 )] });
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema is downgrayyed';
+ $dm->upgrade_single_step({ version_set => [qw( 1.0 2.0 )] });
+}
+
+VERSION3: {
+ use_ok 'DBICVersion_v3';
+ my $s = DBICVersion::Schema->connect(@connection);
+ my $dm = Translator->new({
+ schema => $s,
+ script_directory => $sql_dir,
+ databases => ['SQLite'],
+ sql_translator_args => { add_drop_table => 0 },
+ txn_wrap => 0,
+ });
+
+ ok( $dm, 'DBIC::DH::SQL::Translator w/3.0 instantiates correctly');
+
+ my $version = $s->schema_version();
+ $dm->prepare_deploy;
+ ok(
+ -f catfile(qw( t sql SQLite deploy 3.0 001-auto.sql )),
+ '2.0 schema gets generated properly'
+ );
+ $dm->prepare_downgrade({
+ from_version => $version,
+ to_version => '1.0',
+ version_set => [$version, '1.0']
+ });
+ ok(
+ -f catfile(qw( t sql SQLite downgrade 3.0-1.0 001-auto.sql )),
+ '3.0-1.0 diff gets generated properly'
+ );
+ $dm->prepare_upgrade({
+ from_version => '1.0',
+ to_version => $version,
+ version_set => ['1.0', $version]
+ });
+ ok(
+ -f catfile(qw( t sql SQLite upgrade 1.0-3.0 001-auto.sql )),
+ '1.0-3.0 diff gets generated properly'
+ );
+ $dm->prepare_upgrade({
+ from_version => '2.0',
+ to_version => $version,
+ version_set => ['2.0', $version]
+ });
+ dies_ok {
+ $dm->prepare_upgrade({
+ from_version => '2.0',
+ to_version => $version,
+ version_set => ['2.0', $version]
+ });
+ }
+ 'prepare_upgrade dies if you clobber an existing upgrade file' ;
+ ok(
+ -f catfile(qw( t sql SQLite upgrade 1.0-2.0 001-auto.sql )),
+ '2.0-3.0 diff gets generated properly'
+ );
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ biff => 'frew',
+ })
+ } 'schema not deployed';
+ $dm->upgrade_single_step({ version_set => [qw( 2.0 3.0 )] });
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ biff => 'frew',
+ })
+ } 'schema is deployed';
+ dies_ok {
+ $dm->upgrade_single_step({ version_set => [qw( 2.0 3.0 )] });
+ } 'dies when sql dir does not exist';
+}
+done_testing;
+#vim: ts=2 sw=2 expandtab
diff --git a/t/deploy_methods/sql_translator_deprecated.t b/t/deploy_methods/sql_translator_deprecated.t
new file mode 100644
index 0000000..617b31c
--- /dev/null
+++ b/t/deploy_methods/sql_translator_deprecated.t
@@ -0,0 +1,93 @@
+#!perl
+
+use Test::More;
+use Test::Exception;
+
+use lib 't/lib';
+use DBICDHTest;
+use aliased
+ 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::Deprecated';
+
+use File::Spec::Functions;
+
+my $dbh = DBI->connect('dbi:SQLite::memory:');
+my @connection = (sub { $dbh }, { ignore_version => 1 });
+my $sql_dir = 't/sql';
+
+DBICDHTest::ready;
+
+VERSION1: {
+ use_ok 'DBICVersion_v1';
+ my $s = DBICVersion::Schema->connect(@connection);
+ my $dm = Deprecated->new({
+ schema => $s,
+ script_directory => $sql_dir,
+ databases => ['SQLite'],
+ sql_translator_args => { add_drop_table => 0 },
+ });
+
+ ok( $dm, 'DBIC::DH::DM::SQLT::Deprecated gets instantiated correctly' );
+
+ $dm->prepare_deploy;
+
+ ok(
+ -f catfile(qw( t sql DBICVersion-Schema-1.0-SQLite.sql )),
+ '1.0 schema gets generated properly'
+ );
+
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ })
+ } 'schema not deployed';
+ $dm->deploy;
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ })
+ } 'schema is deployed';
+}
+
+VERSION2: {
+ use_ok 'DBICVersion_v2';
+ my $s = DBICVersion::Schema->connect(@connection);
+ my $dm = Deprecated->new({
+ schema => $s,
+ script_directory => $sql_dir,
+ databases => ['SQLite'],
+ });
+
+ ok(
+ $dm,
+ 'DBIC::DH::DM::SQLT::Deprecated gets instantiated correctly w/ version 2.0'
+ );
+
+ $version = $s->schema_version;
+ $dm->prepare_deploy;
+ $dm->prepare_upgrade({
+ from_version => '1.0',
+ to_version => $version,
+ version_set => ['1.0', $version]
+ });
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema not deployed';
+ dies_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema not uppgrayyed';
+ $dm->upgrade_single_step({ version_set => ['1.0', $version] });
+ lives_ok {
+ $s->resultset('Foo')->create({
+ bar => 'frew',
+ baz => 'frew',
+ })
+ } 'schema is deployed';
+}
+done_testing;
+#vim: ts=2 sw=2 expandtab
diff --git a/t/deploy_methods/sql_translator_protoschema_transform.t b/t/deploy_methods/sql_translator_protoschema_transform.t
new file mode 100644
index 0000000..3771232
--- /dev/null
+++ b/t/deploy_methods/sql_translator_protoschema_transform.t
@@ -0,0 +1,67 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+use lib 't/lib';
+use DBICDHTest;
+use aliased 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator';
+use File::Spec::Functions;
+use File::Path qw(rmtree mkpath);
+
+my $dbh = DBI->connect('dbi:SQLite::memory:');
+my @connection = (sub { $dbh }, { ignore_version => 1 });
+my $sql_dir = 't/sql';
+
+DBICDHTest::ready;
+
+VERSION1: {
+ use_ok 'DBICVersion_v1';
+ my $s = DBICVersion::Schema->connect(@connection);
+ my $dm = Translator->new({
+ schema => $s,
+ script_directory => $sql_dir,
+ databases => ['SQLite'],
+ sql_translator_args => { add_drop_table => 0 },
+ });
+
+ $dm->prepare_deploy;
+ $dm->deploy;
+}
+
+VERSION2: {
+ use_ok 'DBICVersion_v2';
+ my $s = DBICVersion::Schema->connect(@connection);
+ my $dm = Translator->new({
+ schema => $s,
+ script_directory => $sql_dir,
+ databases => ['SQLite'],
+ sql_translator_args => { add_drop_table => 0 },
+ txn_wrap => 1,
+ });
+
+ $dm->prepare_deploy;
+ mkpath(catfile(qw( t sql _preprocess_schema upgrade 1.0-2.0 )));
+ open my $prerun, '>',
+ catfile(qw( t sql _preprocess_schema upgrade 1.0-2.0 003-semiautomatic.pl ));
+ print {$prerun}
+ 'sub {
+ use File::Touch;
+ touch(q(robotparty))
+ if $_[0]->isa("SQL::Translator::Schema")
+ && $_[1]->isa("SQL::Translator::Schema");
+ }';
+ close $prerun;
+ $dm->prepare_upgrade({
+ from_version => '1.0',
+ to_version => '2.0',
+ version_set => [qw(1.0 2.0)]
+ });
+ ok -e 'robotparty', 'intermediate script ran with the right args';
+ $dm->upgrade_single_step({ version_set => [qw( 1.0 2.0 )] });
+}
+done_testing;
+#vim: ts=2 sw=2 expandtab
diff --git a/t/lib/DBICDHTest.pm b/t/lib/DBICDHTest.pm
new file mode 100644
index 0000000..eddd418
--- /dev/null
+++ b/t/lib/DBICDHTest.pm
@@ -0,0 +1,17 @@
+package DBICDHTest;
+
+use strict;
+use warnings;
+
+use File::Path 'remove_tree';
+use Test::More;
+use Test::Exception;
+
+sub ready {
+ if (-d 't/sql') {
+ remove_tree('t/sql');
+ mkdir 't/sql';
+ }
+}
+
+1;
diff --git a/t/lib/DBICVersion_v1.pm b/t/lib/DBICVersion_v1.pm
new file mode 100644
index 0000000..2eee7af
--- /dev/null
+++ b/t/lib/DBICVersion_v1.pm
@@ -0,0 +1,32 @@
+package DBICVersion::Foo;
+
+use base 'DBIx::Class::Core';
+use strict;
+use warnings;
+
+__PACKAGE__->table('Foo');
+
+__PACKAGE__->add_columns(
+ foo => {
+ data_type => 'INTEGER',
+ is_auto_increment => 1,
+ },
+ bar => {
+ data_type => 'VARCHAR',
+ size => '10'
+ },
+);
+
+__PACKAGE__->set_primary_key('foo');
+
+package DBICVersion::Schema;
+use base 'DBIx::Class::Schema';
+use strict;
+use warnings;
+
+our $VERSION = '1.0';
+
+__PACKAGE__->register_class('Foo', 'DBICVersion::Foo');
+__PACKAGE__->load_components('DeploymentHandler::VersionStorage::Standard::Component');
+
+1;
diff --git a/t/lib/DBICVersion_v2.pm b/t/lib/DBICVersion_v2.pm
new file mode 100644
index 0000000..602a1c3
--- /dev/null
+++ b/t/lib/DBICVersion_v2.pm
@@ -0,0 +1,37 @@
+package DBICVersion::Foo;
+
+use base 'DBIx::Class::Core';
+use strict;
+use warnings;
+
+__PACKAGE__->table('Foo');
+
+__PACKAGE__->add_columns(
+ foo => {
+ data_type => 'INTEGER',
+ is_auto_increment => 1,
+ },
+ bar => {
+ data_type => 'VARCHAR',
+ size => '10'
+ },
+ baz => {
+ data_type => 'VARCHAR',
+ size => '10',
+ is_nullable => 1,
+ },
+);
+
+__PACKAGE__->set_primary_key('foo');
+
+package DBICVersion::Schema;
+use base 'DBIx::Class::Schema';
+use strict;
+use warnings;
+
+our $VERSION = '2.0';
+
+__PACKAGE__->register_class('Foo', 'DBICVersion::Foo');
+__PACKAGE__->load_components('DeploymentHandler::VersionStorage::Standard::Component');
+
+1;
diff --git a/t/lib/DBICVersion_v3.pm b/t/lib/DBICVersion_v3.pm
new file mode 100644
index 0000000..e7a94ea
--- /dev/null
+++ b/t/lib/DBICVersion_v3.pm
@@ -0,0 +1,42 @@
+package DBICVersion::Foo;
+
+use base 'DBIx::Class::Core';
+use strict;
+use warnings;
+
+__PACKAGE__->table('Foo');
+
+__PACKAGE__->add_columns(
+ foo => {
+ data_type => 'INTEGER',
+ is_auto_increment => 1,
+ },
+ bar => {
+ data_type => 'VARCHAR',
+ size => '10'
+ },
+ baz => {
+ data_type => 'VARCHAR',
+ size => '10',
+ is_nullable => 1,
+ },
+ biff => {
+ data_type => 'VARCHAR',
+ size => '10',
+ is_nullable => 1,
+ },
+);
+
+__PACKAGE__->set_primary_key('foo');
+
+package DBICVersion::Schema;
+use base 'DBIx::Class::Schema';
+use strict;
+use warnings;
+
+our $VERSION = '3.0';
+
+__PACKAGE__->register_class('Foo', 'DBICVersion::Foo');
+__PACKAGE__->load_components('DeploymentHandler::VersionStorage::Standard::Component');
+
+1;
diff --git a/t/lib/DBICVersion_v4.pm b/t/lib/DBICVersion_v4.pm
new file mode 100644
index 0000000..602a1c3
--- /dev/null
+++ b/t/lib/DBICVersion_v4.pm
@@ -0,0 +1,37 @@
+package DBICVersion::Foo;
+
+use base 'DBIx::Class::Core';
+use strict;
+use warnings;
+
+__PACKAGE__->table('Foo');
+
+__PACKAGE__->add_columns(
+ foo => {
+ data_type => 'INTEGER',
+ is_auto_increment => 1,
+ },
+ bar => {
+ data_type => 'VARCHAR',
+ size => '10'
+ },
+ baz => {
+ data_type => 'VARCHAR',
+ size => '10',
+ is_nullable => 1,
+ },
+);
+
+__PACKAGE__->set_primary_key('foo');
+
+package DBICVersion::Schema;
+use base 'DBIx::Class::Schema';
+use strict;
+use warnings;
+
+our $VERSION = '2.0';
+
+__PACKAGE__->register_class('Foo', 'DBICVersion::Foo');
+__PACKAGE__->load_components('DeploymentHandler::VersionStorage::Standard::Component');
+
+1;
diff --git a/t/no-component-lib/DBICDHTest.pm b/t/no-component-lib/DBICDHTest.pm
new file mode 100644
index 0000000..eddd418
--- /dev/null
+++ b/t/no-component-lib/DBICDHTest.pm
@@ -0,0 +1,17 @@
+package DBICDHTest;
+
+use strict;
+use warnings;
+
+use File::Path 'remove_tree';
+use Test::More;
+use Test::Exception;
+
+sub ready {
+ if (-d 't/sql') {
+ remove_tree('t/sql');
+ mkdir 't/sql';
+ }
+}
+
+1;
diff --git a/t/no-component-lib/DBICVersion_v1.pm b/t/no-component-lib/DBICVersion_v1.pm
new file mode 100644
index 0000000..4e3b51d
--- /dev/null
+++ b/t/no-component-lib/DBICVersion_v1.pm
@@ -0,0 +1,31 @@
+package DBICVersion::Foo;
+
+use base 'DBIx::Class::Core';
+use strict;
+use warnings;
+
+__PACKAGE__->table('Foo');
+
+__PACKAGE__->add_columns(
+ foo => {
+ data_type => 'INTEGER',
+ is_auto_increment => 1,
+ },
+ bar => {
+ data_type => 'VARCHAR',
+ size => '10'
+ },
+);
+
+__PACKAGE__->set_primary_key('foo');
+
+package DBICVersion::Schema;
+use base 'DBIx::Class::Schema';
+use strict;
+use warnings;
+
+our $VERSION = '1.0';
+
+__PACKAGE__->register_class('Foo', 'DBICVersion::Foo');
+
+1;
diff --git a/t/no-component-lib/DBICVersion_v2.pm b/t/no-component-lib/DBICVersion_v2.pm
new file mode 100644
index 0000000..06e2c90
--- /dev/null
+++ b/t/no-component-lib/DBICVersion_v2.pm
@@ -0,0 +1,36 @@
+package DBICVersion::Foo;
+
+use base 'DBIx::Class::Core';
+use strict;
+use warnings;
+
+__PACKAGE__->table('Foo');
+
+__PACKAGE__->add_columns(
+ foo => {
+ data_type => 'INTEGER',
+ is_auto_increment => 1,
+ },
+ bar => {
+ data_type => 'VARCHAR',
+ size => '10'
+ },
+ baz => {
+ data_type => 'VARCHAR',
+ size => '10',
+ is_nullable => 1,
+ },
+);
+
+__PACKAGE__->set_primary_key('foo');
+
+package DBICVersion::Schema;
+use base 'DBIx::Class::Schema';
+use strict;
+use warnings;
+
+our $VERSION = '2.0';
+
+__PACKAGE__->register_class('Foo', 'DBICVersion::Foo');
+
+1;
diff --git a/t/no-component-lib/DBICVersion_v3.pm b/t/no-component-lib/DBICVersion_v3.pm
new file mode 100644
index 0000000..4cd43f0
--- /dev/null
+++ b/t/no-component-lib/DBICVersion_v3.pm
@@ -0,0 +1,41 @@
+package DBICVersion::Foo;
+
+use base 'DBIx::Class::Core';
+use strict;
+use warnings;
+
+__PACKAGE__->table('Foo');
+
+__PACKAGE__->add_columns(
+ foo => {
+ data_type => 'INTEGER',
+ is_auto_increment => 1,
+ },
+ bar => {
+ data_type => 'VARCHAR',
+ size => '10'
+ },
+ baz => {
+ data_type => 'VARCHAR',
+ size => '10',
+ is_nullable => 1,
+ },
+ biff => {
+ data_type => 'VARCHAR',
+ size => '10',
+ is_nullable => 1,
+ },
+);
+
+__PACKAGE__->set_primary_key('foo');
+
+package DBICVersion::Schema;
+use base 'DBIx::Class::Schema';
+use strict;
+use warnings;
+
+our $VERSION = '3.0';
+
+__PACKAGE__->register_class('Foo', 'DBICVersion::Foo');
+
+1;
diff --git a/t/no-component-lib/DBICVersion_v4.pm b/t/no-component-lib/DBICVersion_v4.pm
new file mode 100644
index 0000000..06e2c90
--- /dev/null
+++ b/t/no-component-lib/DBICVersion_v4.pm
@@ -0,0 +1,36 @@
+package DBICVersion::Foo;
+
+use base 'DBIx::Class::Core';
+use strict;
+use warnings;
+
+__PACKAGE__->table('Foo');
+
+__PACKAGE__->add_columns(
+ foo => {
+ data_type => 'INTEGER',
+ is_auto_increment => 1,
+ },
+ bar => {
+ data_type => 'VARCHAR',
+ size => '10'
+ },
+ baz => {
+ data_type => 'VARCHAR',
+ size => '10',
+ is_nullable => 1,
+ },
+);
+
+__PACKAGE__->set_primary_key('foo');
+
+package DBICVersion::Schema;
+use base 'DBIx::Class::Schema';
+use strict;
+use warnings;
+
+our $VERSION = '2.0';
+
+__PACKAGE__->register_class('Foo', 'DBICVersion::Foo');
+
+1;
diff --git a/t/release-pod-syntax.t b/t/release-pod-syntax.t
new file mode 100644
index 0000000..d46a955
--- /dev/null
+++ b/t/release-pod-syntax.t
@@ -0,0 +1,15 @@
+#!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();
diff --git a/t/sql/SQLite/deploy/1.0/001-auto-__VERSION.sql b/t/sql/SQLite/deploy/1.0/001-auto-__VERSION.sql
new file mode 100644
index 0000000..578d0a1
--- /dev/null
+++ b/t/sql/SQLite/deploy/1.0/001-auto-__VERSION.sql
@@ -0,0 +1,18 @@
+--
+-- Created by SQL::Translator::Producer::SQLite
+-- Created on Thu Jul 29 22:06:10 2010
+--
+
+;
+BEGIN TRANSACTION;
+--
+-- Table: dbix_class_deploymenthandler_versions
+--
+CREATE TABLE dbix_class_deploymenthandler_versions (
+ id INTEGER PRIMARY KEY NOT NULL,
+ version varchar(50) NOT NULL,
+ ddl text,
+ upgrade_sql text
+);
+CREATE UNIQUE INDEX dbix_class_deploymenthandler_versions_version ON dbix_class_deploymenthandler_versions (version);
+COMMIT
\ No newline at end of file
diff --git a/t/sql/_source/deploy/1.0/001-auto-__VERSION.yml b/t/sql/_source/deploy/1.0/001-auto-__VERSION.yml
new file mode 100644
index 0000000..535c2cb
--- /dev/null
+++ b/t/sql/_source/deploy/1.0/001-auto-__VERSION.yml
@@ -0,0 +1,173 @@
+---
+schema:
+ procedures: {}
+ tables:
+ dbix_class_deploymenthandler_versions:
+ constraints:
+ - deferrable: 1
+ expression: ''
+ fields:
+ - id
+ match_type: ''
+ name: ''
+ on_delete: ''
+ on_update: ''
+ options: []
+ reference_fields: []
+ reference_table: ''
+ type: PRIMARY KEY
+ - deferrable: 1
+ expression: ''
+ fields:
+ - version
+ match_type: ''
+ name: dbix_class_deploymenthandler_versions_version
+ on_delete: ''
+ on_update: ''
+ options: []
+ reference_fields: []
+ reference_table: ''
+ type: UNIQUE
+ fields:
+ ddl:
+ data_type: text
+ default_value: ~
+ is_nullable: 1
+ is_primary_key: 0
+ is_unique: 0
+ name: ddl
+ order: 3
+ size:
+ - 0
+ id:
+ data_type: int
+ default_value: ~
+ is_auto_increment: 1
+ is_nullable: 0
+ is_primary_key: 1
+ is_unique: 0
+ name: id
+ order: 1
+ size:
+ - 0
+ upgrade_sql:
+ data_type: text
+ default_value: ~
+ is_nullable: 1
+ is_primary_key: 0
+ is_unique: 0
+ name: upgrade_sql
+ order: 4
+ size:
+ - 0
+ version:
+ data_type: varchar
+ default_value: ~
+ is_nullable: 0
+ is_primary_key: 0
+ is_unique: 1
+ name: version
+ order: 2
+ size:
+ - 50
+ indices: []
+ name: dbix_class_deploymenthandler_versions
+ options: []
+ order: 1
+ triggers: {}
+ views: {}
+translator:
+ add_drop_table: 0
+ filename: ~
+ no_comments: 0
+ parser_args:
+ package: &1 !!perl/hash:DBICVersion::Schema
+ class_mappings:
+ DBICVersion::Foo: Foo
+ DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult: __VERSION
+ source_registrations:
+ Foo: !!perl/hash:DBIx::Class::ResultSource::Table
+ _columns:
+ bar:
+ data_type: VARCHAR
+ size: 10
+ foo:
+ data_type: INTEGER
+ is_auto_increment: 1
+ _columns_info_loaded: 0
+ _ordered_columns:
+ - foo
+ - bar
+ _primaries: &2
+ - foo
+ _relationships: {}
+ _unique_constraints:
+ primary: *2
+ name: Foo
+ result_class: DBICVersion::Foo
+ resultset_attributes: {}
+ resultset_class: DBIx::Class::ResultSet
+ schema: *1
+ source_name: Foo
+ sqlt_deploy_callback: default_sqlt_deploy_hook
+ __VERSION: !!perl/hash:DBIx::Class::ResultSource::Table
+ _columns:
+ ddl:
+ data_type: text
+ is_nullable: 1
+ id:
+ data_type: int
+ is_auto_increment: 1
+ upgrade_sql:
+ data_type: text
+ is_nullable: 1
+ version:
+ data_type: varchar
+ size: 50
+ _columns_info_loaded: 0
+ _ordered_columns:
+ - id
+ - version
+ - ddl
+ - upgrade_sql
+ _primaries: &3
+ - id
+ _relationships: {}
+ _unique_constraints:
+ dbix_class_deploymenthandler_versions_version:
+ - version
+ primary: *3
+ name: dbix_class_deploymenthandler_versions
+ result_class: DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult
+ resultset_attributes: {}
+ resultset_class: DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResultSet
+ schema: *1
+ source_name: __VERSION
+ sqlt_deploy_callback: default_sqlt_deploy_hook
+ storage: !!perl/hash:DBIx::Class::Storage::DBI
+ _connect_info:
+ - &4 !!perl/code '{ "DUMMY" }'
+ - ignore_version: 1
+ _dbh_gen: 0
+ _dbi_connect_info:
+ - *4
+ _dbic_connect_attributes:
+ AutoCommit: 1
+ PrintError: 0
+ RaiseError: 1
+ ignore_version: 1
+ _in_dbh_do: 0
+ _sql_maker: ~
+ _sql_maker_opts: {}
+ debugobj: !!perl/hash:DBIx::Class::Storage::Statistics {}
+ savepoints: []
+ schema: *1
+ transaction_depth: 0
+ sources:
+ - __VERSION
+ parser_type: SQL::Translator::Parser::DBIx::Class
+ producer_args: {}
+ producer_type: SQL::Translator::Producer::YAML
+ show_warnings: 0
+ trace: 0
+ version: 0.11006
diff --git a/t/version_handlers/db_schema_versions.t b/t/version_handlers/db_schema_versions.t
new file mode 100644
index 0000000..0bc25ad
--- /dev/null
+++ b/t/version_handlers/db_schema_versions.t
@@ -0,0 +1,70 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+use lib 't/lib';
+use aliased
+ 'DBIx::Class::DeploymentHandler::VersionHandler::DatabaseToSchemaVersions';
+
+{
+ my $vh = DatabaseToSchemaVersions->new({
+ to_version => '5.0',
+ database_version => '1.0',
+ schema_version => '1.0',
+ });
+
+ ok( $vh, 'VersionHandler gets instantiated' );
+ ok(
+ eq_array( $vh->next_version_set, [qw( 1.0 5.0 )] ),
+ 'db version and to_version get correctly put into version set'
+ );
+ ok( !$vh->next_version_set, 'next_version_set only works once');
+ ok( !$vh->next_version_set, 'seriously.');
+}
+
+{
+ my $vh = DatabaseToSchemaVersions->new({
+ database_version => '1.0',
+ schema_version => '1.0',
+ });
+
+ ok( $vh, 'VersionHandler gets instantiated' );
+ ok(
+ !$vh->next_version_set,
+ 'VersionHandler is null when schema_version and db_verison are the same'
+ );
+}
+
+{
+ my $vh = DatabaseToSchemaVersions->new({
+ database_version => '1.0',
+ schema_version => '1.0',
+ });
+
+ ok( $vh, 'VersionHandler gets instantiated' );
+ ok(
+ !$vh->next_version_set,
+ 'VersionHandler is null when schema_version and db_verison are the same'
+ );
+}
+
+{
+ my $vh = DatabaseToSchemaVersions->new({
+ database_version => '1.0',
+ schema_version => '10.0',
+ });
+
+ ok( $vh, 'VersionHandler gets instantiated' );
+ ok(
+ eq_array( $vh->next_version_set, [qw( 1.0 10.0 )] ),
+ 'db version and schema version get correctly put into version set'
+ );
+ ok( !$vh->next_version_set, 'VersionHandler is null on next try' );
+}
+
+done_testing;
+# vim: ts=2 sw=2 expandtab
diff --git a/t/version_handlers/explict_versions.t b/t/version_handlers/explict_versions.t
new file mode 100644
index 0000000..07ad3dd
--- /dev/null
+++ b/t/version_handlers/explict_versions.t
@@ -0,0 +1,138 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+use lib 't/lib';
+use aliased
+ 'DBIx::Class::DeploymentHandler::VersionHandler::ExplicitVersions';
+
+my $versions = [map "$_.0", 0..100];
+
+{
+ my $vh = ExplicitVersions->new({
+ ordered_versions => $versions,
+ schema_version => '2.0',
+ database_version => '1.0',
+ });
+
+ ok $vh, 'VersionHandler gets instantiated';
+
+ ok(
+ eq_array($vh->next_version_set, [qw( 1.0 2.0 )]),
+ 'first version pair works'
+ );
+ ok(
+ !$vh->next_version_set,
+ 'next version set returns undef when we are done'
+ );
+}
+
+{
+ my $vh = ExplicitVersions->new({
+ ordered_versions => $versions,
+ to_version => '1.0',
+ schema_version => '1.0',
+ database_version => '1.0',
+ });
+
+ ok $vh, 'VersionHandler gets instantiated';
+
+ ok(
+ !$vh->next_version_set,
+ 'next version set returns undef if we are at the version requested'
+ );
+}
+
+{
+ my $vh = ExplicitVersions->new({
+ ordered_versions => $versions,
+ to_version => '5.0',
+ schema_version => '1.0',
+ database_version => '1.0',
+ });
+
+ ok $vh, 'VersionHandler gets instantiated';
+ ok(
+ eq_array($vh->next_version_set, [qw( 1.0 2.0 )]),
+ 'first version pair works'
+ );
+ ok(
+ eq_array($vh->next_version_set, [qw( 2.0 3.0 )]),
+ 'second version pair works'
+ );
+ ok(
+ eq_array($vh->next_version_set, [qw( 3.0 4.0 )]),
+ 'third version pair works'
+ );
+ ok(
+ eq_array($vh->next_version_set, [qw( 4.0 5.0 )]),
+ 'fourth version pair works'
+ );
+ ok( !$vh->next_version_set, 'no more versions after final pair' );
+ ok( !$vh->next_version_set, 'still no more versions after final pair' );
+}
+
+{
+ my $vh = ExplicitVersions->new({
+ ordered_versions => $versions,
+ to_version => '1.0',
+ schema_version => '5.0',
+ database_version => '5.0',
+ });
+
+ ok $vh, 'VersionHandler gets instantiated';
+ ok(
+ eq_array($vh->previous_version_set, [qw( 5.0 4.0 )]),
+ 'first version pair works'
+ );
+ ok(
+ eq_array($vh->previous_version_set, [qw( 4.0 3.0 )]),
+ 'second version pair works'
+ );
+ ok(
+ eq_array($vh->previous_version_set, [qw( 3.0 2.0 )]),
+ 'third version pair works'
+ );
+ ok(
+ eq_array($vh->previous_version_set, [qw( 2.0 1.0 )]),
+ 'fourth version pair works'
+ );
+ ok( !$vh->previous_version_set, 'no more versions after final pair' );
+ ok( !$vh->previous_version_set, 'still no more versions after final pair' );
+}
+
+dies_ok {
+ my $vh = ExplicitVersions->new({
+ ordered_versions => $versions,
+ schema_version => '2.0',
+ database_version => '1.1',
+ });
+ $vh->next_version_set
+} 'dies if database version not found in ordered_versions';
+
+dies_ok {
+ my $vh = ExplicitVersions->new({
+ ordered_versions => $versions,
+ to_version => '0.0',
+ schema_version => '1.0',
+ database_version => '1.0',
+ });
+ $vh->next_version_set;
+} 'cannot request an upgrade before the current version';
+
+dies_ok {
+ my $vh = ExplicitVersions->new({
+ ordered_versions => $versions,
+ to_version => '2.0',
+ schema_version => '1.0',
+ database_version => '1.0',
+ });
+ $vh->previous_version_set;
+} 'cannot request a downgrade after the current version';
+
+done_testing;
+#vim: ts=2 sw=2 expandtab
diff --git a/t/version_handlers/monotonic.t b/t/version_handlers/monotonic.t
new file mode 100644
index 0000000..c0d1f2f
--- /dev/null
+++ b/t/version_handlers/monotonic.t
@@ -0,0 +1,129 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+use lib 't/lib';
+use aliased
+ 'DBIx::Class::DeploymentHandler::VersionHandler::Monotonic';
+
+{
+ my $vh = Monotonic->new({
+ schema_version => 2,
+ database_version => 1,
+ });
+
+ ok $vh, 'VersionHandler gets instantiated';
+
+ ok(
+ eq_array($vh->next_version_set, [1,2]),
+ 'first version pair works'
+ );
+ ok(
+ !$vh->next_version_set,
+ 'next version set returns undef when we are done'
+ );
+}
+
+{
+ my $vh = Monotonic->new({
+ to_version => 1,
+ schema_version => 1,
+ database_version => 1,
+ });
+
+ ok $vh, 'VersionHandler gets instantiated';
+
+ ok(
+ !$vh->next_version_set,
+ 'next version set returns undef if we are at the version requested'
+ );
+}
+
+ONETOFIVE: {
+ my $vh = Monotonic->new({
+ to_version => 5,
+ schema_version => 1,
+ database_version => 1,
+ });
+
+ ok $vh, 'VersionHandler gets instantiated';
+ ok(
+ eq_array($vh->next_version_set, [1,2]),
+ 'first version pair works'
+ );
+ ok(
+ eq_array($vh->next_version_set, [2,3]),
+ 'second version pair works'
+ );
+ ok(
+ eq_array($vh->next_version_set, [3,4]),
+ 'third version pair works'
+ );
+ ok(
+ eq_array($vh->next_version_set, [4,5]),
+ 'fourth version pair works'
+ );
+ ok( !$vh->next_version_set, 'no more versions after final pair' );
+ ok( !$vh->next_version_set, 'still no more versions after final pair' );
+}
+
+FIVETOONE: {
+ my $vh = Monotonic->new({
+ to_version => 1,
+ schema_version => 1,
+ database_version => 5,
+ });
+
+ ok $vh, 'VersionHandler gets instantiated';
+ ok(
+ eq_array($vh->previous_version_set, [5,4]),
+ 'first version pair works'
+ );
+ ok(
+ eq_array($vh->previous_version_set, [4,3]),
+ 'second version pair works'
+ );
+ ok(
+ eq_array($vh->previous_version_set, [3,2]),
+ 'third version pair works'
+ );
+ ok(
+ eq_array($vh->previous_version_set, [2,1]),
+ 'fourth version pair works'
+ );
+ ok( !$vh->previous_version_set, 'no more versions before initial pair' );
+ ok( !$vh->previous_version_set, 'still no more versions before initial pair' );
+}
+
+dies_ok {
+ my $vh = Monotonic->new({
+ schema_version => 2,
+ database_version => '1.1',
+ });
+ $vh->next_version_set
+} 'dies if database version not an Int';
+
+dies_ok {
+ my $vh = Monotonic->new({
+ to_version => 0,
+ schema_version => 1,
+ database_version => 1,
+ });
+ $vh->next_version_set;
+} 'cannot request an upgrade version before the current version';
+
+dies_ok {
+ my $vh = Monotonic->new({
+ to_version => 2,
+ schema_version => 1,
+ database_version => 1,
+ });
+ $vh->previous_version_set;
+} 'cannot request a downgrade version after the current version';
+
+done_testing;
+#vim: ts=2 sw=2 expandtab
diff --git a/t/version_storages/standard.t b/t/version_storages/standard.t
new file mode 100644
index 0000000..27dafc8
--- /dev/null
+++ b/t/version_storages/standard.t
@@ -0,0 +1,94 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+
+use lib 't/lib';
+use DBICDHTest;
+use aliased 'DBIx::Class::DeploymentHandler::VersionStorage::Standard';
+use aliased 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator';
+
+use DBICVersion_v1;
+use DBIx::Class::DeploymentHandler;
+my $dbh = DBI->connect('dbi:SQLite::memory:');
+my @connection = (sub { $dbh }, { ignore_version => 1 });
+my $sql_dir = 't/sql';
+
+my $s = DBICVersion::Schema->connect(@connection);
+{
+ my $warning;
+ local $SIG{__WARN__} = sub {$warning = shift};
+ my $t = DBICVersion::Schema->connect('frewfrew', '', '');
+ like( $warning, qr/Your DB is currently unversioned. Please call upgrade on your schema to sync the DB/, 'warning when database is unversioned');
+}
+
+DBICDHTest::ready;
+
+my $dm = Translator->new({
+ schema => $s,
+ script_directory => $sql_dir,
+ databases => ['SQLite'],
+ sql_translator_args => { add_drop_table => 0 },
+});
+
+my $vs = Standard->new({ schema => $s });
+
+$dm->prepare_resultsource_install({
+ result_source => $vs->version_rs->result_source
+});
+
+ok( $vs, 'DBIC::DH::VersionStorage::Standard instantiates correctly' );
+
+ok( !$vs->version_storage_is_installed, 'VersionStorage is not yet installed' );
+
+$dm->install_resultsource({
+ result_source => $vs->version_rs->result_source,
+ version => '1.0',
+});
+
+ok( $vs->version_storage_is_installed, 'VersionStorage is now installed' );
+
+
+$vs->add_database_version({
+ version => '1.0',
+});
+
+ok(
+ eq_array(
+ [ $vs->version_rs->search(undef, {order_by => 'id'})->get_column('version')->all],
+ [ '1.0' ],
+ ),
+ 'initial version works correctly'
+);
+
+is( $vs->database_version, '1.0', 'database version is 1.0');
+$vs->add_database_version({
+ version => '2.0',
+});
+is( $vs->database_version, '2.0', 'database version is 2.0');
+
+ok(
+ eq_array(
+ [ $vs->version_rs->search(undef, {order_by => 'id'})->get_column('version')->all],
+ [ '1.0', '2.0', ],
+ ),
+ 'adding another version works correctly'
+);
+
+my $u;
+{
+ my $warning;
+ local $SIG{__WARN__} = sub {$warning = shift};
+ $u = DBICVersion::Schema->connect(sub { $dbh });
+ like( $warning, qr/Versions out of sync. This is 1\.0, your database contains version 2\.0, please call upgrade on your Schema\./, 'warning when database/schema mismatch');
+}
+
+
+$vs->version_rs->delete;
+
+ok( $vs->version_storage_is_installed, 'VersionStorage is still installed even if all versions are deleted' );
+done_testing;
diff --git a/weaver.ini b/weaver.ini
new file mode 100644
index 0000000..b0cf58e
--- /dev/null
+++ b/weaver.ini
@@ -0,0 +1,22 @@
+[@CorePrep]
+
+[Name]
+
+[Region / prelude]
+
+[Generic / SYNOPSIS]
+[Generic / DESCRIPTION]
+[Generic / OVERVIEW]
+
+[Leftovers]
+
+[Collect / ATTRIBUTES]
+command = attr
+
+[Collect / METHODS]
+command = method
+
+[Region / postlude]
+
+[Authors]
+[Legal]
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libdbix-class-deploymenthandler-perl.git
More information about the Pkg-perl-cvs-commits
mailing list