DBIx-Class-DeploymentHandler-0.002208 000755 001750 001750 0 12217355667 16321 5 ustar 00frew frew 000000 000000 README 100644 001750 001750 12672 12217355667 17312 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208 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 its 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
yield the best overall mileage. Each role it uses has its 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, define the version in your main schema file (maybe using
$VERSION).
Then you'll want to just install the version_storage:
my $s = My::Schema->connect(...);
my $dh = DBIx::Class::DeploymentHandler->new({ schema => $s });
$dh->prepare_version_storage_install;
$dh->install_version_storage;
Then set your database version:
$dh->add_database_version({ version => $s->schema_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 its 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 Matthew 25: Ministries:
, but there are a host of other charities that can
do much more good than I will with your money. (Third party charity info
here:
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
COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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.
Changes 100644 001750 001750 15042 12217355667 17717 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208 Revision history for DBIx-Class-DeploymentHandler
0.002208 2013-09-21 12:47:31 America/Chicago
- Fix under perl 5.19.4 (thanks Hugmeir)
0.002207 2013-08-29 23:18:27 CST6CDT
- Modernize usage of Log::Contextual, creating a simple example for how to
make static loggers for modules and applications
0.002206 2013-03-09 12:50:57 CST6CDT
- Fix embarrassing broken charity link
0.002205 2013-02-19 15:26:53 CST6CDT
- Fix spurious warning caused by serializing $dbh (Peter Rabbitson)
0.002204 2013-01-09 20:34:56 CST6CDT
- Add semicolon to generated SQL for "correctness"
0.002203 2012-11-17 16:38:24 CST6CDT
- Put MetaYAML back in dist
0.002202 2012-09-02 12:23:07 America/Chicago
- Fix RT#79301
0.002201 2012-08-18 13:31:00 America/Chicago
- Fix RT#76323
0.002200 2012-08-02 20:48:52 America/Chicago
- Added helpful logging for the schema_from_schema_loader ScriptHelper
- Added much more helpful error for "Can't find source for..." error in
migration scripts, based on code from DBIx::Class::Migration
- Test suite now is fully parallelizable
- Switch ::ScriptHelpers to Sub::Exporter::Progressive
- Switch from Test::Exception to Test::Fatal
0.002115 2012-07-10 13:36:35 America/Chicago
- Make tests use actual temp files to make certain systems stop failing tests
- Remove dep on File::Touch
0.002114 2012-05-07 08:05:20 America/Chicago
- Correctly set the version deployed to the version requested on install
instead of just the current schema version
0.002113 2012-05-05 23:09:33 America/Chicago
- Remove isa check on schema attributes so that you may pass the schema
class instead of the schema object
0.002112 2012-04-03 21:11:19 America/Chicago
- Handle errors in Perl Scripts better
- Stop supporting FindBin by localizing $0, just use Dir::Self if you
need that
0.002111 2012-03-29 20:09:45 America/Chicago
- Improve docs by linking from implementations to their roles
0.002110 2012-03-14 21:22:36 America/Chicago
- Use ->count instead of ->next to check if version storage is deployed
(->next caused issues on MSSQL due to length of DDL)
- Fix a couple stupid documentation issues (Phillip Smith)
0.002100 2012-03-03 17:09:21 CST6CDT
- Wrap upgrades, downgrades, and installs in a transaction, as a failure
to add a version to the version table should cause a rollback
- Allow user to specify version of schema to install
- Added better sandboxing (stolen straight from Plack::Util) for coderefs
to avoid accidental leakage
- Sandboxing also makes $0 and thus FindBin et al work in perl scripts
0.002000 2012-02-28 21:20:48 CST6CDT
- Added DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::ScriptHelpers,
ALL users who use perl scripts during migrations are encouraged to use
schema_from_schema_loader from that package.
0.001008 2012-02-19 10:12:34 CST6CDT
- Added dep on parent, bump dep on DBD::SQLite to avoid silly failures
0.001007 2012-02-16 08:58:30 CST6CDT
- removed the rest of the references to Method::Signatures::Simple
0.001006 2012-02-01 21:18:38 CST6CDT
- Fix install to allow you to deploy to a given version (jnap)
- Fix the backup method to use storage, not schema (jnap)
- Fix the reasonable defaults for downgrading (jnap)
- Stop warning all the time (ribasushi)
- croak on a couple errors that should be fatal
- Stop deleting the wrong version (for downgrades)
- Fix documentation for in the Cookbook (moltar)
- removed Method::Signatures::Simple stuff (dhoss)
0.001005 2011-04-13 15:21:08 CST6CDT
- Add _any "version" for running code for all versions
- Fix more minor pod niggles
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
LICENSE 100644 001750 001750 43725 12217355667 17442 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208 This software is copyright (c) 2013 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) 2013 by Arthur Axel "fREW" Schmidt.
This is free software, licensed under:
The GNU General Public License, Version 1, February 1989
GNU GENERAL PUBLIC LICENSE
Version 1, February 1989
Copyright (C) 1989 Free Software Foundation, Inc.
51 Franklin St, Suite 500, Boston, MA 02110-1335 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The license agreements of most software companies try to keep users
at the mercy of those companies. By contrast, our General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. The
General Public License applies to the Free Software Foundation's
software and to any other program whose authors commit to using it.
You can use it for your programs, too.
When we speak of free software, we are referring to freedom, not
price. Specifically, the General Public License is designed to make
sure that you have the freedom to give away or sell copies of free
software, that you receive source code or can get it if you want it,
that you can change the software or use pieces of it in new free
programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of a such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must tell them their rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License Agreement applies to any program or other work which
contains a notice placed by the copyright holder saying it may be
distributed under the terms of this General Public License. The
"Program", below, refers to any such program or work, and a "work based
on the Program" means either the Program or any work containing the
Program or a portion of it, either verbatim or with modifications. Each
licensee is addressed as "you".
1. You may copy and distribute verbatim copies of the Program's source
code as you receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice and
disclaimer of warranty; keep intact all the notices that refer to this
General Public License and to the absence of any warranty; and give any
other recipients of the Program a copy of this General Public License
along with the Program. You may charge a fee for the physical act of
transferring a copy.
2. You may modify your copy or copies of the Program or any portion of
it, and copy and distribute such modifications under the terms of Paragraph
1 above, provided that you also do the following:
a) cause the modified files to carry prominent notices stating that
you changed the files and the date of any change; and
b) cause the whole of any work that you distribute or publish, that
in whole or in part contains the Program or any part thereof, either
with or without modifications, to be licensed at no charge to all
third parties under the terms of this General Public License (except
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
d) You may charge a fee for the physical act of transferring a
copy, and you may at your option offer warranty protection in
exchange for a fee.
Mere aggregation of another independent work with the Program (or its
derivative) on a volume of a storage or distribution medium does not bring
the other work under the scope of these terms.
3. You may copy and distribute the Program (or a portion or derivative of
it, under Paragraph 2) in object code or executable form under the terms of
Paragraphs 1 and 2 above provided that you also do one of the following:
a) accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of
Paragraphs 1 and 2 above; or,
b) accompany it with a written offer, valid for at least three
years, to give any third party free (except for a nominal charge
for the cost of distribution) a complete machine-readable copy of the
corresponding source code, to be distributed under the terms of
Paragraphs 1 and 2 above; or,
c) accompany it with the information you received as to where the
corresponding source code may be obtained. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form alone.)
Source code for a work means the preferred form of the work for making
modifications to it. For an executable file, complete source code means
all the source code for all modules it contains; but, as a special
exception, it need not include source code for modules which are standard
libraries that accompany the operating system on which the executable
file runs, or for standard header files or definitions files that
accompany that operating system.
4. You may not copy, modify, sublicense, distribute or transfer the
Program except as expressly provided under this General Public License.
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
the Program is void, and will automatically terminate your rights to use
the Program under this License. However, parties who have received
copies, or rights to use copies, from you under this General Public
License will not have their licenses terminated so long as such parties
remain in full compliance.
5. By copying, distributing or modifying the Program (or any work based
on the Program) you indicate your acceptance of this license to do so,
and all its terms and conditions.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the original
licensor to copy, distribute or modify the Program subject to these
terms and conditions. You may not impose any further restrictions on the
recipients' exercise of the rights granted herein.
7. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of the license which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
the license, you may choose any version ever published by the Free Software
Foundation.
8. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
Appendix: How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
Copyright (C) 19yy
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the
program `Gnomovision' (a program to direct compilers to make passes
at assemblers) written by James Hacker.
, 1 April 1989
Ty Coon, President of Vice
That's all there is to it!
--- The Artistic License 1.0 ---
This software is Copyright (c) 2013 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
cpanfile 100644 001750 001750 1357 12217355667 20114 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208 requires 'parent' => 0.225;
requires 'autodie' => 0;
requires 'namespace::autoclean' => 0;
requires 'Log::Contextual' => 0.005005;
requires 'Path::Class' => 0.26;
requires 'DBIx::Class' => 0.08121;
requires 'Moose' => 1.0;
requires 'Moo' => 1.003000;
requires 'MooseX::Role::Parameterized' => 0.18;
requires 'Try::Tiny' => 0;
requires 'SQL::Translator' => 0.11005;
requires 'Carp' => 0;
requires 'Carp::Clan' => 0;
requires 'Context::Preserve' => 0.01;
requires 'Sub::Exporter::Progressive' => 0;
requires 'Text::Brew' => 0.02;
on test => sub {
requires 'Test::More' => 0.88;
requires 'Test::Fatal' => 0.006;
requires 'DBD::SQLite' => 1.35;
requires 'aliased' => 0;
requires 'Test::Requires' => 0.06;
requires 'File::Temp' => 0;
};
dist.ini 100644 001750 001750 1230 12217355667 20042 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208 name = DBIx-Class-DeploymentHandler
author = Arthur Axel "fREW" Schmidt
license = Perl_5
copyright_holder = Arthur Axel "fREW" Schmidt
version = 0.002208
[NextRelease]
[@Git]
[@Basic]
[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
bugtracker.web = https://github.com/frioux/DBIx-Class-DeploymentHandler/issues
[MetaJSON]
[PodWeaver]
[PkgVersion]
[ReadmeFromPod]
[PodSyntaxTests]
[Prereqs::FromCPANfile]
META.yml 100644 001750 001750 2046 12217355667 17655 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208 ---
abstract: 'Extensible DBIx::Class deployment'
author:
- "Arthur Axel \"fREW\" Schmidt "
build_requires:
DBD::SQLite: 1.35
File::Temp: 0
Test::Fatal: 0.006
Test::More: 0.88
Test::Requires: 0.06
aliased: 0
configure_requires:
ExtUtils::MakeMaker: 6.30
dynamic_config: 0
generated_by: 'Dist::Zilla version 4.300039, CPAN::Meta::Converter version 2.120921'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: DBIx-Class-DeploymentHandler
requires:
Carp: 0
Carp::Clan: 0
Context::Preserve: 0.01
DBIx::Class: 0.08121
Log::Contextual: 0.005005
Moo: 1.003
Moose: 1
MooseX::Role::Parameterized: 0.18
Path::Class: 0.26
SQL::Translator: 0.11005
Sub::Exporter::Progressive: 0
Text::Brew: 0.02
Try::Tiny: 0
autodie: 0
namespace::autoclean: 0
parent: 0.225
resources:
bugtracker: https://github.com/frioux/DBIx-Class-DeploymentHandler/issues
repository: git://git.shadowcat.co.uk/dbsrgits/DBIx-Class-DeploymentHandler.git
version: 0.002208
MANIFEST 100644 001750 001750 5155 12217355667 17541 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208 Changes
LICENSE
MANIFEST
META.json
META.yml
Makefile.PL
README
cpanfile
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/DeployMethod/SQL/Translator/ScriptHelpers.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/LogImporter.pm
lib/DBIx/Class/DeploymentHandler/LogRouter.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/10-split-sql-chunk.t
t/bugs/01-emailed-bug-01.t
t/deploy_methods/coderef-leakage.t
t/deploy_methods/script-helpers.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/version_handlers/db_schema_versions.t
t/version_handlers/explict_versions.t
t/version_handlers/monotonic.t
t/version_storages/standard.t
weaver.ini
META.json 100644 001750 001750 3776 12217355667 20040 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208 {
"abstract" : "Extensible DBIx::Class deployment",
"author" : [
"Arthur Axel \"fREW\" Schmidt "
],
"dynamic_config" : 0,
"generated_by" : "Dist::Zilla version 4.300039, CPAN::Meta::Converter version 2.120921",
"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.30"
}
},
"develop" : {
"requires" : {
"Test::Pod" : "1.41"
}
},
"runtime" : {
"requires" : {
"Carp" : "0",
"Carp::Clan" : "0",
"Context::Preserve" : "0.01",
"DBIx::Class" : "0.08121",
"Log::Contextual" : "0.005005",
"Moo" : "1.003",
"Moose" : "1",
"MooseX::Role::Parameterized" : "0.18",
"Path::Class" : "0.26",
"SQL::Translator" : "0.11005",
"Sub::Exporter::Progressive" : "0",
"Text::Brew" : "0.02",
"Try::Tiny" : "0",
"autodie" : "0",
"namespace::autoclean" : "0",
"parent" : "0.225"
}
},
"test" : {
"requires" : {
"DBD::SQLite" : "1.35",
"File::Temp" : "0",
"Test::Fatal" : "0.006",
"Test::More" : "0.88",
"Test::Requires" : "0.06",
"aliased" : "0"
}
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/frioux/DBIx-Class-DeploymentHandler/issues"
},
"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.002208"
}
weaver.ini 100644 001750 001750 357 12217355667 20361 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208 [@CorePrep]
[Name]
[Region / prelude]
[Generic / SYNOPSIS]
[Generic / DESCRIPTION]
[Generic / OVERVIEW]
[Leftovers]
[Collect / ATTRIBUTES]
command = attr
[Collect / METHODS]
command = method
[Region / postlude]
[Authors]
[Legal]
Makefile.PL 100644 001750 001750 4060 12217355667 20354 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208
use strict;
use warnings;
use ExtUtils::MakeMaker 6.30;
my %WriteMakefileArgs = (
"ABSTRACT" => "Extensible DBIx::Class deployment",
"AUTHOR" => "Arthur Axel \"fREW\" Schmidt ",
"BUILD_REQUIRES" => {},
"CONFIGURE_REQUIRES" => {
"ExtUtils::MakeMaker" => "6.30"
},
"DISTNAME" => "DBIx-Class-DeploymentHandler",
"EXE_FILES" => [],
"LICENSE" => "perl",
"NAME" => "DBIx::Class::DeploymentHandler",
"PREREQ_PM" => {
"Carp" => 0,
"Carp::Clan" => 0,
"Context::Preserve" => "0.01",
"DBIx::Class" => "0.08121",
"Log::Contextual" => "0.005005",
"Moo" => "1.003",
"Moose" => 1,
"MooseX::Role::Parameterized" => "0.18",
"Path::Class" => "0.26",
"SQL::Translator" => "0.11005",
"Sub::Exporter::Progressive" => 0,
"Text::Brew" => "0.02",
"Try::Tiny" => 0,
"autodie" => 0,
"namespace::autoclean" => 0,
"parent" => "0.225"
},
"TEST_REQUIRES" => {
"DBD::SQLite" => "1.35",
"File::Temp" => 0,
"Test::Fatal" => "0.006",
"Test::More" => "0.88",
"Test::Requires" => "0.06",
"aliased" => 0
},
"VERSION" => "0.002208",
"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.63_03) } ) {
my $tr = delete $WriteMakefileArgs{TEST_REQUIRES};
my $br = $WriteMakefileArgs{BUILD_REQUIRES};
for my $mod ( keys %$tr ) {
if ( exists $br->{$mod} ) {
$br->{$mod} = $tr->{$mod} if $tr->{$mod} > $br->{$mod};
}
else {
$br->{$mod} = $tr->{$mod};
}
}
}
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);
t 000755 001750 001750 0 12217355667 16505 5 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208 03-deprecated.t 100644 001750 001750 5726 12217355667 21364 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t #!perl
use strict;
use warnings;
use lib 't/lib';
use DBICDHTest;
use aliased 'DBIx::Class::DeploymentHandler::Deprecated';
use Test::More;
use File::Temp 'tempdir';
use Test::Fatal qw(lives_ok dies_ok);
my $dbh = DBICDHTest::dbh();
my @connection = (sub { $dbh }, { ignore_version => 1 });
my $sql_dir = tempdir( CLEANUP => 1 );
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({ version => '1.0' });
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;
04-preconnect.t 100644 001750 001750 2163 12217355667 21415 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t #!perl
use strict;
use warnings;
use lib 't/lib';
use DBICDHTest;
use DBIx::Class::DeploymentHandler;
use aliased 'DBIx::Class::DeploymentHandler', 'DH';
use Path::Class 'dir';
use Test::More;
use File::Temp 'tempdir';
my $db = 'dbi:SQLite::memory:';
my @connection = ($db, '', '', { ignore_version => 1, on_connect_do => sub { die }});
my $sql_dir = tempdir( CLEANUP => 1 );
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');
dir($sql_dir, qw(SQLite initialize 1))->mkpath;
$handler->initialize({ version => 1, storage_type => 'SQLite' });
ok !$s->storage->connected, 'creating schema did not connect';
}
done_testing;
lib 000755 001750 001750 0 12217355667 17253 5 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t DBICDHTest.pm 100644 001750 001750 223 12217355667 21503 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t/lib package DBICDHTest;
use strict;
use warnings;
use DBI;
sub dbh {
DBI->connect('dbi:SQLite::memory:', undef, undef, { RaiseError => 1 })
}
1;
02-instantiation.t 100644 001750 001750 7424 12217355667 22144 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t #!perl
use strict;
use warnings;
use lib 't/lib';
use DBICDHTest;
use DBIx::Class::DeploymentHandler;
use aliased 'DBIx::Class::DeploymentHandler', 'DH';
use Test::More;
use File::Temp 'tempdir';
use Test::Fatal qw(lives_ok dies_ok);
my $dbh = DBICDHTest::dbh();
my @connection = (sub { $dbh }, { ignore_version => 1 });
my $sql_dir = tempdir( CLEANUP => 1 );
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;
10-split-sql-chunk.t 100644 001750 001750 537 12217355667 22273 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t use strict;
use warnings;
use Test::More tests => 1;
use DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator;
*split_sql_chunk =
*DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::_split_sql_chunk;
is_deeply [ split_sql_chunk( <<'END' ) ], [ 'SELECT * FROM YADAH END' ];
BEGIN
-- stuff
SELECT * FROM YADAH
END;
END
release-pod-syntax.t 100644 001750 001750 450 12217355667 22535 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t #!perl
BEGIN {
unless ($ENV{RELEASE_TESTING}) {
require Test::More;
Test::More::plan(skip_all => 'these tests are for release candidate testing');
}
}
use Test::More;
eval "use Test::Pod 1.41";
plan skip_all => "Test::Pod 1.41 required for testing POD" if $@;
all_pod_files_ok();
DBICVersion_v4.pm 100644 001750 001750 1174 12217355667 22434 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t/lib 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;
DBICVersion_v1.pm 100644 001750 001750 1060 12217355667 22423 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t/lib 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;
DBICVersion_v2.pm 100644 001750 001750 1174 12217355667 22432 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t/lib 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;
DBICVersion_v3.pm 100644 001750 001750 1311 12217355667 22424 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t/lib 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;
bugs 000755 001750 001750 0 12217355667 17445 5 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t 01-emailed-bug-01.t 100644 001750 001750 2062 12217355667 22601 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t/bugs #!perl
use strict;
use warnings;
use lib 't/lib';
use DBICDHTest;
use DBIx::Class::DeploymentHandler;
use aliased 'DBIx::Class::DeploymentHandler', 'DH';
use Test::More;
use File::Temp 'tempdir';
use Test::Fatal qw(lives_ok dies_ok);
my $dbh = DBICDHTest::dbh();
my @connection = (sub { $dbh }, { ignore_version => 1 });
my $sql_dir = tempdir( CLEANUP => 1 );
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;
02-instantiation-no-ddl.t 100644 001750 001750 7321 12217355667 23313 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t #!perl
use strict;
use warnings;
use lib 't/lib';
use DBICDHTest;
use DBIx::Class::DeploymentHandler;
use aliased 'DBIx::Class::DeploymentHandler', 'DH';
use Test::More;
use File::Temp 'tempdir';
use Test::Fatal qw(lives_ok dies_ok);
use DBI;
my $dbh = DBICDHTest::dbh();
my @connection = (sub { $dbh }, { ignore_version => 1 });
my $sql_dir = tempdir( CLEANUP => 1 );
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';
is $handler->version_storage->database_version => 2,
'database version is down to 2';
}
done_testing;
version_storages 000755 001750 001750 0 12217355667 22101 5 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t standard.t 100644 001750 001750 4664 12217355667 24240 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t/version_storages #!perl
use strict;
use warnings;
use Test::More;
use lib 't/lib';
use DBICDHTest;
use aliased 'DBIx::Class::DeploymentHandler::VersionStorage::Standard';
use aliased 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator';
use File::Temp 'tempdir';
use DBICVersion_v1;
use DBIx::Class::DeploymentHandler;
my $dbh = DBICDHTest::dbh();
my @connection = (sub { $dbh }, { ignore_version => 1 });
my $sql_dir = tempdir( CLEANUP => 1 );
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');
}
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;
version_handlers 000755 001750 001750 0 12217355667 22052 5 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t monotonic.t 100644 001750 001750 5352 12217355667 24411 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t/version_handlers #!perl
use strict;
use warnings;
use Test::More;
use Test::Fatal qw(lives_ok dies_ok);
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
no-component-lib 000755 001750 001750 0 12217355667 21665 5 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t DBICDHTest.pm 100644 001750 001750 211 12217355667 24112 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t/no-component-lib package DBICDHTest;
use strict;
use warnings;
sub dbh {
DBI->connect('dbi:SQLite::memory:', undef, undef, { RaiseError => 1 })
}
1;
02-instantiation-wo-component.t 100644 001750 001750 10350 12217355667 24577 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t #!perl
use strict;
use warnings;
use lib 't/no-component-lib';
use DBICDHTest;
use DBIx::Class::DeploymentHandler;
use aliased 'DBIx::Class::DeploymentHandler', 'DH';
use Test::More;
use File::Temp 'tempdir';
use Test::Fatal qw(lives_ok dies_ok);
my $dbh = DBICDHTest::dbh();
my @connection = (sub { $dbh }, { ignore_version => 1 });
my $sql_dir = tempdir( CLEANUP => 1 );
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({ version => 1 });
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;
subtest 'bug deploying first version' => sub {
my $dbh = DBICDHTest::dbh();
my @connection = (sub { $dbh }, { ignore_version => 1 });
my $s = DBICVersion::Schema->connect(@connection);
my $handler = DH->new({
script_directory => $sql_dir,
schema => $s,
databases => 'SQLite',
});
$handler->install({ version => 1 });
is($handler->database_version, 1, 'correctly set version to 1');
};
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;
deploy_methods 000755 001750 001750 0 12217355667 21524 5 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t script-helpers.t 100644 001750 001750 5573 12217355667 25027 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t/deploy_methods #!perl
use strict;
use warnings;
use Test::More;
use DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::ScriptHelpers ':all';;
use Test::Fatal;
use lib 't/lib';
use DBICVersion_v1;
use DBICDHTest;
my $dbh = DBICDHTest->dbh;
my @connection = (sub { $dbh }, { ignore_version => 1 });
my $schema = DBICVersion::Schema->connect(@connection);
$schema->deploy;
subtest dbh => sub {
my $ran;
dbh(sub {
my ($dbh, $versions) = @_;
$ran = 1;
is($dbh, $schema->storage->dbh, 'dbh is correctly reused');
is_deeply $versions, [1,2], 'version correctly passed';
isa_ok($dbh, 'DBI::db');
})->($schema, [1,2]);
ok $ran, 'coderef ran';
};
subtest schema_from_schema_loader => sub {
use Test::Requires;
test_requires('DBIx::Class::Schema::Loader');
my $build_sl_test = sub {
my @connection = @_;
return sub {
my $ran;
my $outer_schema = DBICVersion::Schema->connect(@connection);
$outer_schema->deploy;
schema_from_schema_loader({ naming => 'v4' }, sub {
my ($schema, $versions) = @_;
$ran = 1;
is(
$outer_schema->storage->dbh,
$schema->storage->dbh,
'dbh is correctly reused',
);
is_deeply $versions, [2,3], 'version correctly passed';
like(ref $schema, qr/SHSchema::\d+/, 'schema has expected type');
isa_ok($schema, 'DBIx::Class::Schema', 'and schema is not totally worthless -');
})->($outer_schema, [2,3]);
ok $ran, 'coderef ran';
}
};
subtest 'sub { $dbh }, ...' => $build_sl_test->(
sub { DBICDHTest->dbh },
{ ignore_version => 1 },
);
subtest '$dsn, $user, $pass, ...' => $build_sl_test->(
'dbi:SQLite::memory:', undef, undef,
{ RaiseError => 1 },
{ ignore_version => 1 }
);
subtest '({ dsn => ..., ... })' => $build_sl_test->({
dsn => 'dbi:SQLite::memory:',
user => undef,
password => undef,
RaiseError => 1,
ignore_version => 1,
});
subtest '({ dbh_maker => ..., ... })' => $build_sl_test->({
dbh_maker => sub { DBICDHTest->dbh },
RaiseError => 1,
ignore_version => 1,
});
subtest '({ dbh_maker => ..., ... })' => $build_sl_test->({
dbh_maker => sub { DBICDHTest->dbh },
RaiseError => 1,
ignore_version => 1,
});
subtest 'error handling' => sub {
my $outer_schema = DBICVersion::Schema->connect(
'dbi:SQLite::memory:', undef, undef,
{ RaiseError => 1 },
{ ignore_version => 1 },
);
$outer_schema->deploy;
like(exception {
schema_from_schema_loader({ naming => 'v4' }, sub {
my ($schema, $versions) = @_;
$schema->resultset('foo')
})->($outer_schema, [2,3]);
}, qr/Foo <== Possible Match/, 'correct error');
};
};
done_testing;
sql_translator.t 100644 001750 001750 17243 12217355667 25150 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t/deploy_methods #!perl
use strict;
use warnings;
use Test::More;
use Test::Fatal qw(lives_ok dies_ok);
use lib 't/lib';
use DBICDHTest;
use aliased 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator';
use Path::Class qw(dir file);
use File::Temp qw(tempfile tempdir);
my $dbh = DBICDHTest::dbh();
my @connection = (sub { $dbh }, { ignore_version => 1 });
my $sql_dir = tempdir( CLEANUP => 1 );
my (undef, $stuffthatran_fn) = tempfile(OPEN => 0);
for (qw(initialize upgrade downgrade deploy)) {
dir($sql_dir, '_common', $_, '_any')->mkpath;
open my $fh, '>',
file($sql_dir, '_common', $_, qw(_any 000-win.pl ));
print {$fh} qq^sub {open my \$fh, ">>", '$stuffthatran_fn'; use Data::Dumper::Concise; print {\$fh} join(",", \@{\$_[1]||[]}) . "\\n"; }^;
close $fh;
}
for (qw(initialize upgrade downgrade deploy)) {
dir($sql_dir, 'SQLite', $_, '_any')->mkpath;
open my $fh, '>',
file($sql_dir, 'SQLite', $_, qw(_any 000-win2.pl ));
print {$fh} qq^sub {open my \$fh, ">>", '$stuffthatran_fn'; use Data::Dumper::Concise; print {\$fh} join(",", \@{\$_[1]||[]}) . "\\n"; }^;
close $fh;
}
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;
dir($sql_dir, qw(SQLite initialize 1.0 ))->mkpath;
open my $prerun, '>',
file($sql_dir, qw(SQLite initialize 1.0 003-semiautomatic.pl ));
my (undef, $fn) = tempfile(OPEN => 0);
print {$prerun} "sub { open my \$fh, '>', '$fn'}";
close $prerun;
$dm->initialize({ version => '1.0' });
ok -e $fn, 'code got run in preinit';
dies_ok {$dm->prepare_deploy} 'prepare_deploy dies if you run it twice' ;
ok(
-f file($sql_dir, qw(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 file($sql_dir, qw(SQLite deploy 2.0 001-auto.sql )),
'2.0 schema gets generated properly'
);
dir($sql_dir, qw(SQLite upgrade 1.0-2.0 ))->mkpath;
$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 file($sql_dir, qw(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'
);
dir($sql_dir, qw(SQLite downgrade 2.0-1.0 ))->mkpath;
$dm->prepare_downgrade({
from_version => $version,
to_version => '1.0',
version_set => [$version, '1.0']
});
ok(
-f file($sql_dir, qw(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';
dir($sql_dir, qw(_common upgrade 1.0-2.0 ))->mkpath;
open my $common, '>',
file($sql_dir, qw(_common upgrade 1.0-2.0 002-semiautomatic.sql ));
print {$common} qq;
close $common;
open my $common_pl, '>',
file($sql_dir, qw(_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 file($sql_dir, qw(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 file($sql_dir, qw(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 file($sql_dir, qw(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 file($sql_dir, qw(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';
}
my $stuff_that_ran = do { local( @ARGV, $/ ) = $stuffthatran_fn; <> };
is $stuff_that_ran,
'
1.0
1.0
1.0,2.0
1.0,2.0
2.0,1.0
2.0,1.0
1.0,2.0
1.0,2.0
2.0,3.0
2.0,3.0
2.0,3.0
2.0,3.0
', '_any got ran the right amount of times with the right args';
done_testing;
#vim: ts=2 sw=2 expandtab
coderef-leakage.t 100644 001750 001750 1705 12217355667 25052 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t/deploy_methods #!perl
use strict;
use warnings;
use Test::More;
use Test::Fatal qw(lives_ok dies_ok);
use aliased 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator';
use File::Temp 'tempdir';
use lib 't/lib';
use DBICDHTest;
my $dbh = DBICDHTest::dbh();
my $sql_dir = tempdir( CLEANUP => 1 );
my @connection = (sub { $dbh }, { ignore_version => 1 });
use_ok 'DBICVersion_v1';
my $s = DBICVersion::Schema->connect(@connection);
my $dm = Translator->new({
schema => $s,
script_directory => $sql_dir,
});
my ($fname1, $fname2) = @_;
{
my $fh = File::Temp->new(UNLINK => 0);
print {$fh} 'sub leak {} sub { leak() }';
$fname1 = $fh->filename;
close $fh;
}
{
my $fh = File::Temp->new(UNLINK => 0);
print {$fh} 'sub { leak() }';
$fname2 = $fh->filename;
close $fh;
}
$dm->_run_perl($fname1, [1]);
dies_ok { $dm->_run_perl($fname2, [1]) } 'info should not leak between coderefs';
done_testing;
END { unlink $fname1; unlink $fname2 }
Class 000755 001750 001750 0 12217355667 20643 5 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx DeploymentHandler.pm 100644 001750 001750 17003 12217355667 25000 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class package DBIx::Class::DeploymentHandler;
{
$DBIx::Class::DeploymentHandler::VERSION = '0.002208';
}
# 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
__END__
=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 is, as its name suggests, a tool for
deploying and upgrading databases with L. It is designed to be
much more flexible than L, hence the use of
L and lots of roles.
C itself is just a recommended set of roles
that we think will not only work well for everyone, but will also yield the
best overall mileage. Each role it uses has its 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 worked (and
L 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, 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 extends
L, 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 expects to be filled. They would be
L,
L,
L, and
L.
=head1 THIS SUCKS
You started your project and weren't using C?
Lucky for you I had you in mind when I wrote this doc.
First,
L
in your main schema file (maybe using C<$VERSION>).
Then you'll want to just install the version_storage:
my $s = My::Schema->connect(...);
my $dh = DBIx::Class::DeploymentHandler->new({ schema => $s });
$dh->prepare_version_storage_install;
$dh->install_version_storage;
Then set your database version:
$dh->add_database_version({ version => $s->schema_version });
Now you should be able to use C 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, C,
C, C, C, and C. 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, C, C, C,
C, and C. Each level can be set on its 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 Matthew 25: Ministries:
L, but there are a host of other
charities that can do much more good than I will with your money.
(Third party charity info here:
L
=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
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
DBICVersion_v4.pm 100644 001750 001750 1114 12217355667 25040 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t/no-component-lib 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;
DBICVersion_v1.pm 100644 001750 001750 760 12217355667 25023 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t/no-component-lib 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;
DBICVersion_v3.pm 100644 001750 001750 1251 12217355667 25041 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t/no-component-lib 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;
DBICVersion_v2.pm 100644 001750 001750 1114 12217355667 25036 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t/no-component-lib 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;
explict_versions.t 100644 001750 001750 6232 12217355667 26002 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t/version_handlers #!perl
use strict;
use warnings;
use Test::More;
use Test::Fatal qw(lives_ok dies_ok);
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
DeploymentHandler 000755 001750 001750 0 12217355667 24261 5 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class Dad.pm 100644 001750 001750 15511 12217355667 25472 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::Dad;
{
$DBIx::Class::DeploymentHandler::Dad::VERSION = '0.002208';
}
# ABSTRACT: Parent class for DeploymentHandlers
use Moose;
require DBIx::Class::Schema; # loaded for type constraint
use Carp::Clan '^DBIx::Class::DeploymentHandler';
use DBIx::Class::DeploymentHandler::LogImporter ':log';
use DBIx::Class::DeploymentHandler::Types;
has 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 }
sub install {
my $self = shift;
my $version = (shift @_ || {})->{version} || $self->to_version;
log_info { "installing version $version" };
croak 'Install not possible as versions table already exists in database'
if $self->version_storage_is_installed;
$self->txn_do(sub {
my $ddl = $self->deploy({ version=> $version });
$self->add_database_version({
version => $version,
ddl => $ddl,
});
});
}
sub upgrade {
log_info { 'upgrading' };
my $self = shift;
my $ran_once = 0;
$self->txn_do(sub {
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 { 'downgrading' };
my $self = shift;
my $ran_once = 0;
$self->txn_do(sub {
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->[0] });
}
});
log_warn { 'no version to run downgrade' } unless $ran_once;
}
sub backup {
my $self = shift;
log_info { 'backing up' };
$self->schema->storage->backup($self->backup_directory)
}
__PACKAGE__->meta->make_immutable;
1;
# vim: ts=2 sw=2 expandtab
__END__
=pod
=head1 NAME
DBIx::Class::DeploymentHandler::Dad - Parent class for DeploymentHandlers
=head1 METHODS THAT ARE REQUIRED IN SUBCLASSES
=head2 deploy
See L.
=head2 version_storage_is_installed
See L.
=head2 add_database_version
See L.
=head2 delete_database_version
See L.
=head2 next_version_set
See L.
=head2 previous_version_set
See L.
=head2 upgrade_single_step
See L.
=head2 downgrade_single_step
See L.
=head2 txn_do
See L.
=head1 ORTHODOX METHODS
These methods are not actually B 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
=head2 prepare_deploy
see L
=head2 prepare_resultsource_install
see L
=head2 install_resultsource
see L
=head2 prepare_upgrade
see L
=head2 prepare_downgrade
see L
=head2 SUBCLASSING
All of the methods mentioned in L and
L 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 and
L, 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,
L, and
L.
=head1 ATTRIBUTES
=head2 schema
The L (B) 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
or
$dh->install({ version => 1 })
Deploys the requested version into the database Version defaults to
L. Populates C with C and C.
B: you typically need to call C<< $dh->prepare_deploy >> before you call
this method.
B: you cannot install on top of an already installed database
=head2 upgrade
$dh->upgrade
Upgrades the database one step at a time till L
returns C. Each upgrade step will add a C, C, and
C to the version storage (if C and/or C are
returned from L.
=head2 downgrade
$dh->downgrade
Downgrades the database one step at a time till L
returns C. Each downgrade step will delete a C 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
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
db_schema_versions.t 100644 001750 001750 3042 12217355667 26233 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t/version_handlers #!perl
use strict;
use warnings;
use Test::More;
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
Types.pm 100644 001750 001750 2041 12217355667 26060 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::Types;
{
$DBIx::Class::DeploymentHandler::Types::VERSION = '0.002208';
}
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
__END__
=pod
=head1 NAME
DBIx::Class::DeploymentHandler::Types - Types internal to DBIx::Class::DeploymentHandler
=head1 AUTHOR
Arthur Axel "fREW" Schmidt
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
Logger.pm 100644 001750 001750 2717 12217355667 26205 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::Logger;
{
$DBIx::Class::DeploymentHandler::Logger::VERSION = '0.002208';
}
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";
}
sub new {
my ($self, $options, @rest) = @_;
$options ||= {};
$options->{env_prefix} ||= 'DBICDH';
$self->next::method($options, @rest)
}
1;
__END__
=pod
=head1 NAME
DBIx::Class::DeploymentHandler::Logger
=head1 AUTHOR
Arthur Axel "fREW" Schmidt
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
sql_translator_deprecated.t 100644 001750 001750 4230 12217355667 27300 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t/deploy_methods #!perl
use Test::More;
use Test::Fatal qw(lives_ok dies_ok);
use lib 't/lib';
use DBICDHTest;
use aliased
'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::Deprecated';
use Path::Class 'file';
use File::Temp 'tempdir';
my $dbh = DBICDHTest::dbh();
my @connection = (sub { $dbh }, { ignore_version => 1 });
my $sql_dir = tempdir( CLEANUP => 1 );
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 file($sql_dir, qw(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
LogRouter.pm 100644 001750 001750 2323 12217355667 26701 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::LogRouter;
{
$DBIx::Class::DeploymentHandler::LogRouter::VERSION = '0.002208';
}
use Moo;
use DBIx::Class::DeploymentHandler::Logger;
with 'Log::Contextual::Role::Router';
has _logger => (
is => 'lazy',
builder => sub { DBIx::Class::DeploymentHandler::Logger->new },
);
sub handle_log_request {
my ($self, %message_info) = @_;
my $log_code_block = $message_info{message_sub};
my $args = $message_info{message_args};
my $log_level_name = $message_info{message_level};
my $logger = $self->_logger;
my $is_active = $logger->can("is_${log_level_name}");
return unless defined $is_active && $logger->$is_active;
my $log_message = $log_code_block->(@$args);
$self->_logger->$log_level_name($log_message);
}
sub before_import {}
sub after_import {}
1;
__END__
=pod
=head1 NAME
DBIx::Class::DeploymentHandler::LogRouter
=head1 AUTHOR
Arthur Axel "fREW" Schmidt
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
Deprecated.pm 100644 001750 001750 11145 12217355667 27041 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::Deprecated;
{
$DBIx::Class::DeploymentHandler::Deprecated::VERSION = '0.002208';
}
# 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
__END__
=pod
=head1 NAME
DBIx::Class::DeploymentHandler::Deprecated - (DEPRECATED) Use this if you are stuck in the past
=head1 SYNOPSIS
Look at L. 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 relatively simple. I will make changes
to ensure that it works with output from L 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 and
L.
=head1 WHERE IS ALL THE DOC?!
C extends
L, 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 expects to be filled. They would be
L,
L, and
L. Also, this class
is special in that it applies either
L or
L depending on
your schema.
=head1 AUTHOR
Arthur Axel "fREW" Schmidt
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
LogImporter.pm 100644 001750 001750 1312 12217355667 27217 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::LogImporter;
{
$DBIx::Class::DeploymentHandler::LogImporter::VERSION = '0.002208';
}
use warnings;
use strict;
use parent 'Log::Contextual';
use DBIx::Class::DeploymentHandler::LogRouter;
{
my $router;
sub router { $router ||= DBIx::Class::DeploymentHandler::LogRouter->new }
}
1;
__END__
=pod
=head1 NAME
DBIx::Class::DeploymentHandler::LogImporter
=head1 AUTHOR
Arthur Axel "fREW" Schmidt
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
HandlesDeploy.pm 100644 001750 001750 6636 12217355667 27525 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::HandlesDeploy;
{
$DBIx::Class::DeploymentHandler::HandlesDeploy::VERSION = '0.002208';
}
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';
requires 'txn_do';
1;
# vim: ts=2 sw=2 expandtab
__END__
=pod
=head1 NAME
DBIx::Class::DeploymentHandler::HandlesDeploy - Interface for deploy methods
=head1 KNOWN IMPLEMENTATIONS
=over
=item *
L
=item *
L
=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 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 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 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 to migrate down from the first version to the second version.
The version set uniquely identifies the migration and should match its
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.
=head2 txn_do
$dh->txn_do(sub { ... })
Wrap the passed coderef in a transaction (if transactions are enabled.)
=head1 AUTHOR
Arthur Axel "fREW" Schmidt
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
Manual 000755 001750 001750 0 12217355667 25476 5 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler Intro.pod 100644 001750 001750 13336 12217355667 27463 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler/Manual 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 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.) However, if you are using decimal numbers for versioning,
you will need to create a separate DeploymentHandler class, as per
L, and
set the VersionHandler class_name from Monotonic to ExplicitVersions or
DatabaseToSchemaVersions, as these handle version numbers as strings instead
of integers.
=head1 install.pl
Our first script, C 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 Getopt::Long;
use FindBin;
use lib "$FindBin::Bin/../lib";
use MyDatabase::Main;
my $force_overwrite = 0;
unless ( GetOptions( 'force_overwrite!' => \$force_overwrite ) ) {
die "Invalid options";
}
my $schema = MyDatabase::Main->connect('dbi:SQLite:mydb.db');
my $dh = DH->new(
{
schema => $schema,
script_directory => "$FindBin::Bin/../dbicdh",
databases => 'SQLite',
sql_translator_args => { add_drop_table => 0 },
force_overwrite => $force_overwrite,
}
);
$dh->prepare_install;
$dh->install;
=head2 dbicdh - Our migration scripts
Running C should create the following:
dbicdh/
|-- SQLite
| `-- deploy
| `-- 1
| `-- 001-auto.sql
`-- _source
`-- deploy
`-- 1
`-- 001-auto.yml
You may wish to turn on L
before running this script by setting the environment variable C to
C<1>.
=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:
sub {
my $schema = shift;
$schema->resultset('Artist')->populate([
['artistid', 'name'],
[1, 'Marillion'],
[2, 'The Moutain Goats'],
[3, '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:
#!/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 and C files are the
state of the db as at that version. The C 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
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
HandlesVersioning.pm 100644 001750 001750 7437 12217355667 30414 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::HandlesVersioning;
{
$DBIx::Class::DeploymentHandler::HandlesVersioning::VERSION = '0.002208';
}
use Moose::Role;
# ABSTRACT: Interface for version methods
requires 'next_version_set';
requires 'previous_version_set';
1;
# vim: ts=2 sw=2 expandtab
__END__
=pod
=head1 NAME
DBIx::Class::DeploymentHandler::HandlesVersioning - Interface for version methods
=head1 DESCRIPTION
Typically a VersionHandler will take a C and yeild an iterator of
L.
Typically a call to a VersionHandler's L with a C
of 1 and a C 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 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. 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.
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 might look.
to_version = "users", db_version = 1
[3]
[5]
["users"]
undef
So what just happened there is that C 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 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
=item *
L
=item *
L
=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 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 describing each version that needs to be
"installed" to downgrade to C<< $dh->to_version >>.
=head1 AUTHOR
Arthur Axel "fREW" Schmidt
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
sql_translator_protoschema_transform.t 100644 001750 001750 3350 12217355667 31621 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/t/deploy_methods #!perl
use strict;
use warnings;
use Test::More;
use lib 't/lib';
use DBICDHTest;
use aliased 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator';
use Path::Class qw(dir file);
use File::Temp qw(tempfile tempdir);
my $dbh = DBICDHTest::dbh();
my @connection = (sub { $dbh }, { ignore_version => 1 });
my $sql_dir = tempdir( CLEANUP => 1 );
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;
dir($sql_dir, qw(_preprocess_schema upgrade 1.0-2.0 ))->mkpath;
open my $prerun, '>',
file($sql_dir, qw(_preprocess_schema upgrade 1.0-2.0 003-semiautomatic.pl ));
my (undef, $fn) = tempfile(OPEN => 0);
print {$prerun}
qq^sub {
open my \$fh, ">", '$fn'
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 $fn, '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
WithApplicatorDumple.pm 100644 001750 001750 3704 12217355667 31064 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::WithApplicatorDumple;
{
$DBIx::Class::DeploymentHandler::WithApplicatorDumple::VERSION = '0.002208';
}
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
__END__
=pod
=head1 NAME
DBIx::Class::DeploymentHandler::WithApplicatorDumple
=head1 AUTHOR
Arthur Axel "fREW" Schmidt
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
HandlesVersionStorage.pm 100644 001750 001750 3612 12217355667 31232 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::HandlesVersionStorage;
{
$DBIx::Class::DeploymentHandler::HandlesVersionStorage::VERSION = '0.002208';
}
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
__END__
=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 for examples of what you
might want to do in your own storage.
=head1 KNOWN IMPLEMENTATIONS
=over
=item *
L
=item *
L
=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
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
CatalystIntro.pod 100644 001750 001750 13166 12217355667 31171 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler/Manual 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. Background
information on using PostgreSQL with Catalyst can be found at
L. 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, with password C
$ sudo -u postgres createuser -P catalyst
Enter password for new role:
Enter it again:
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
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:
connect_info => {
dsn => 'dbi:Pg:dbname=deploymentintro',
user => 'catalyst',
password => 'catalyst',
AutoCommit => q{1},
}
Remove C and create a new file called
C 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
#!/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:
C
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
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
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 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
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
WithReasonableDefaults.pm 100644 001750 001750 4172 12217355667 31362 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::WithReasonableDefaults;
{
$DBIx::Class::DeploymentHandler::WithReasonableDefaults::VERSION = '0.002208';
}
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->{to_version} ||= $self->database_version;
$args->{from_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->schema_version;
my $to_version = $self->data_version;
my $version_set = [$from_version, $to_version];
=head2 install_resultsource
Defaulted args:
my $version = $self->to_version;
=head1 AUTHOR
Arthur Axel "fREW" Schmidt
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
VersionStorage 000755 001750 001750 0 12217355667 27233 5 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler Standard.pm 100644 001750 001750 3512 12217355667 31472 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler/VersionStorage package DBIx::Class::DeploymentHandler::VersionStorage::Standard;
{
$DBIx::Class::DeploymentHandler::VersionStorage::Standard::VERSION = '0.002208';
}
use Moose;
use DBIx::Class::DeploymentHandler::LogImporter ':log';
# ABSTRACT: Version storage that does the normal stuff
use DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult;
has 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
__END__
=pod
=head1 NAME
DBIx::Class::DeploymentHandler::VersionStorage::Standard - Version storage that does the normal stuff
=head1 SEE ALSO
This class is an implementation of
L. Pretty much all the
documentation is there.
=head1 AUTHOR
Arthur Axel "fREW" Schmidt
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
VersionHandler 000755 001750 001750 0 12217355667 27204 5 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler Monotonic.pm 100644 001750 001750 4517 12217355667 31656 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler/VersionHandler package DBIx::Class::DeploymentHandler::VersionHandler::Monotonic;
{
$DBIx::Class::DeploymentHandler::VersionHandler::Monotonic::VERSION = '0.002208';
}
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
__END__
=pod
=head1 NAME
DBIx::Class::DeploymentHandler::VersionHandler::Monotonic - Obvious version progressions
=head1 SEE ALSO
This class is an implementation of
L. Pretty much all the
documentation is there.
=head1 AUTHOR
Arthur Axel "fREW" Schmidt
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
Deprecated.pm 100644 001750 001750 5527 12217355667 32002 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler/VersionStorage package DBIx::Class::DeploymentHandler::VersionStorage::Deprecated;
{
$DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::VERSION = '0.002208';
}
use Moose;
use DBIx::Class::DeploymentHandler::LogImporter ':log';
# ABSTRACT: (DEPRECATED) Use this if you are stuck in the past
has 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
__END__
=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 relatively simple. I will make changes
to ensure that it works with output from L 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 SEE ALSO
This class is an implementation of
L. Pretty much all the
documentation is there.
=head1 AUTHOR
Arthur Axel "fREW" Schmidt
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
SQL 000755 001750 001750 0 12217355667 27315 5 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler/DeployMethod Translator.pm 100644 001750 001750 67164 12217355667 32202 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL package DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator;
{
$DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::VERSION = '0.002208';
}
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::LogImporter qw(:log :dlog);
use Context::Preserve;
use Try::Tiny;
use SQL::Translator;
require SQL::Translator::Diff;
require DBIx::Class::Storage; # loaded for type constraint
use DBIx::Class::DeploymentHandler::Types;
use Path::Class qw(file dir);
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 => (
is => 'ro',
required => 1,
);
has storage => (
isa => 'DBIx::Class::Storage',
is => 'ro',
lazy_build => 1,
);
sub _build_storage {
my $self = shift;
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
sub _build_schema_version {
my $self = shift;
$self->schema->schema_version
}
sub __ddl_consume_with_prefix {
my ($self, $type, $versions, $prefix) = @_;
my $base_dir = $self->script_directory;
my $main = dir( $base_dir, $type );
my $common =
dir( $base_dir, '_common', $prefix, join q(-), @{$versions} );
my $common_any =
dir( $base_dir, '_common', $prefix, '_any' );
my $dir;
if (-d $main) {
$dir = dir($main, $prefix, join q(-), @{$versions})
} else {
if ($self->ignore_ddl) {
return []
} else {
croak "$main does not exist; please write/generate some SQL"
}
}
my $dir_any = dir($main, $prefix, '_any');
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;
};
for my $dirname (grep { -d $_ } $common, $common_any, $dir_any) {
opendir my($dh), $dirname;
for my $filename (grep { /\.(?:sql|pl)$/ && -f file($dirname,$_) } readdir $dh) {
unless ($files{$filename}) {
$files{$filename} = file($dirname,$filename);
}
}
closedir $dh;
}
return [@files{sort keys %files}]
}
sub _ddl_initialize_consume_filenames {
my ($self, $type, $version) = @_;
$self->__ddl_consume_with_prefix($type, [ $version ], 'initialize')
}
sub _ddl_schema_consume_filenames {
my ($self, $type, $version) = @_;
$self->__ddl_consume_with_prefix($type, [ $version ], 'deploy')
}
sub _ddl_protoschema_deploy_consume_filenames {
my ($self, $version) = @_;
my $base_dir = $self->script_directory;
my $dir = dir( $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}]
}
sub _ddl_protoschema_upgrade_consume_filenames {
my ($self, $versions) = @_;
my $base_dir = $self->script_directory;
my $dir = dir( $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}]
}
sub _ddl_protoschema_downgrade_consume_filenames {
my ($self, $versions) = @_;
my $base_dir = $self->script_directory;
my $dir = dir( $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}]
}
sub _ddl_protoschema_produce_filename {
my ($self, $version) = @_;
my $dirname = dir( $self->script_directory, '_source', 'deploy', $version );
$dirname->mkpath unless -d $dirname;
return "" . file( $dirname, '001-auto.yml' );
}
sub _ddl_schema_produce_filename {
my ($self, $type, $version) = @_;
my $dirname = dir( $self->script_directory, $type, 'deploy', $version );
$dirname->mkpath unless -d $dirname;
return "" . file( $dirname, '001-auto.sql' );
}
sub _ddl_schema_upgrade_consume_filenames {
my ($self, $type, $versions) = @_;
$self->__ddl_consume_with_prefix($type, $versions, 'upgrade')
}
sub _ddl_schema_downgrade_consume_filenames {
my ($self, $type, $versions) = @_;
$self->__ddl_consume_with_prefix($type, $versions, 'downgrade')
}
sub _ddl_schema_upgrade_produce_filename {
my ($self, $type, $versions) = @_;
my $dir = $self->script_directory;
my $dirname = dir( $dir, $type, 'upgrade', join q(-), @{$versions});
$dirname->mkpath unless -d $dirname;
return "" . file( $dirname, '001-auto.sql' );
}
sub _ddl_schema_downgrade_produce_filename {
my ($self, $type, $versions, $dir) = @_;
my $dirname = dir( $dir, $type, 'downgrade', join q(-), @{$versions} );
$dirname->mkpath unless -d $dirname;
return "" . file( $dirname, '001-auto.sql');
}
sub _run_sql_array {
my ($self, $sql) = @_;
my $storage = $self->storage;
$sql = [ _split_sql_chunk( @$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
}
# split a chunk o' SQL into statements
sub _split_sql_chunk {
my @sql = map { split /;\n/, $_ } @_;
for ( @sql ) {
# strip transactions
s/^(?:BEGIN|BEGIN TRANSACTION|COMMIT).*//mgi;
# trim whitespaces
s/^\s+|\s+$//mg;
# remove comments
s/^--.*//gm;
# remove blank lines
s/^\n//mg;
# put on single line
s/\n/ /g;
}
return @sql;
}
sub _run_sql {
my ($self, $filename) = @_;
log_debug { "Running SQL from $filename" };
return $self->_run_sql_array($self->_read_sql_file($filename));
}
sub _load_sandbox {
my $_file = shift;
my $_package = $_file;
$_package =~ s/([^A-Za-z0-9_])/sprintf("_%2x", ord($1))/eg;
my $fn = eval sprintf <<'END_EVAL', $_package;
package DBICDH::Sandbox::%s;
{
our $app;
$app ||= require $_file;
if ( !$app && ( my $error = $@ || $! )) { die $error; }
$app;
}
END_EVAL
croak $@ if $@;
croak "$_file should define an anonymous sub that takes a schema but it didn't!"
unless ref $fn && ref $fn eq 'CODE';
return $fn;
}
sub _run_perl {
my ($self, $filename, $versions) = @_;
log_debug { "Running Perl from $filename" };
my $fn = _load_sandbox($filename);
Dlog_trace { "Running Perl $_" } $fn;
$fn->($self->schema, $versions)
}
sub txn_do {
my ( $self, $code ) = @_;
return $code->() unless $self->txn_wrap;
my $guard = $self->schema->txn_scope_guard;
return preserve_context { $code->() } after => sub { $guard->commit };
}
sub _run_sql_and_perl {
my ($self, $filenames, $sql_to_run, $versions) = @_;
my @files = @{$filenames};
$self->txn_do(sub {
$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 (map file($_), @files) {
if ($self->ignore_ddl && $filename->basename =~ /^[^-]*-auto.*\.sql$/) {
next FILENAME
} elsif ($filename =~ /\.sql$/) {
$sql .= $self->_run_sql($filename)
} elsif ( $filename =~ /\.pl$/ ) {
$self->_run_perl($filename, $versions)
} else {
croak "A file ($filename) got to deploy that wasn't sql or perl!";
}
}
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, [$version]);
}
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 ($@) {
croak "$filename failed to compile: $@";
} elsif (ref $fn eq 'CODE') {
$fn->()
} else {
croak "$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!";
}
}
}
sub _sqldiff_from_yaml {
my ($self, $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
)];
}
sub _sql_from_yaml {
my ($self, $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 = dir( $self->script_directory, $type, 'deploy', $version );
$dirname->mkpath unless -d $dirname;
return "" . file( $dirname, "001-auto-$source_name.sql" );
}
}
sub _resultsource_protoschema_filename {
my ($self, $source_name) = @_;
return sub {
my ($self, $version) = @_;
my $dirname = dir( $self->script_directory, '_source', 'deploy', $version );
$dirname->mkpath unless -d $dirname;
return "" . file( $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, '', [$version]);
}
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'
);
}
sub _coderefs_per_files {
my ($self, $files) = @_;
no warnings 'redefine';
[map eval do { local( @ARGV, $/ ) = $_; <> }, @$files]
}
sub _prepare_changegrade {
my ($self, $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;
}
}
sub _read_sql_file {
my ($self, $file) = @_;
return unless $file;
local $/ = undef; #sluuuuuurp
open my $fh, '<', $file;
return [ _split_sql_chunk( <$fh> ) ];
}
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, $version_set);
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, $version_set);
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
my $sqlt = SQL::Translator->new({
parser => 'SQL::Translator::Parser::DBIx::Class',
producer => 'SQL::Translator::Producer::YAML',
%{ $sqltargs },
});
my $yml = $sqlt->translate(data => $self->schema);
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
__END__
=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. 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. What's
documented here is extra fun stuff or private methods.
=head1 DIRECTORY LAYOUT
Arguably this is the best feature of L.
It's spiritually based upon L, 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
| `- _any
| `- 999-bump-action.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 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>, and
finally punctuated by
C<$sql_migration_dir/_common/upgrade/_any/999-bump-action.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 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 This directory merely contains directories named after schema
versions, which in turn contain C 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 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 objects.
=item C 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 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. Also note, C<_common>
is a special case. C<_common> will get merged into whatever other files you
already have. This directory can contain the following directories itself:
=over 2
=item C Gets run before the C is Ced. Has the
same structure as the C subdirectory as well; that is, it has a
directory for each schema version. Unlike C, C, and C
though, it can only run C<.pl> files, and the coderef in the perl files get
no arguments passed to them.
=item C Gets run when the schema is Ced. 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.
=item C Gets run when the schema is Cd. 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.
=item C Gets run when the schema is Cd. 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.
=back
=back
Note that there can be an C<_any> in the place of any of the versions (like
C<1-2> or C<1>), which means those scripts will be run B time. So if
you have an C<_any> in C<_common/upgrade>, that script will get run for every
upgrade.
=head1 PERL SCRIPTS
A perl script for this tool is very simple. It merely needs to contain an
anonymous sub that takes a L and the version set as it's
arguments.
A very basic perl script might look like:
#!perl
use strict;
use warnings;
use DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::ScriptHelpers
'schema_from_schema_loader';
schema_from_schema_loader({ naming => 'v4' }, sub {
my $schema = shift;
# [1] for deploy, [1,2] for upgrade or downgrade, probably used with _any
my $versions = shift;
$schema->resultset('Users')->create({
name => 'root',
password => 'root',
})
})
Note that the above uses
L.
Using a raw coderef is strongly discouraged as it is likely to break as you
modify your schema.
=head1 SEE ALSO
This class is an implementation of
L. Pretty much all the
documentation is there.
=head1 ATTRIBUTES
=head2 ignore_ddl
This attribute will, when set to true (default is false), cause the DM to use
L 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 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 (B) that is used to talk to the database
and generate the DDL.
=head2 storage
The L that is I used to talk to the database
and generate the DDL. This is automatically created with L.
=head2 sql_translator_args
The arguments that get passed to L 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
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
Cookbook 000755 001750 001750 0 12217355667 26027 5 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler CustomResultSource.pod 100644 001750 001750 10245 12217355667 32547 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler/Cookbook package DBIx::Class::DeploymentHandler::Cookbook::CustomResultSource;
__END__
=pod
=head1 NAME
DBIx::Class::DeploymentHandler::Cookbook::CustomResultSource
=head1 DESCRIPTION
One of the reasons for the absurd level of flexibility that
L 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;
# the following is necessary for some setups
use MyApp::Schema::DBICDHStorageResult;
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 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({
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;
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
Note: if you are using decimal numbers for versioning, you should ammend
this DeploymentHandler package, setting it's VersionHandler class_name from
Monotonic ( which handles integer only version numbers ) to ExplicitVersions
or DatabaseToSchemaVersions, as these handle version numbers as strings
instead of integers.
=head1 NAME
DBIx::Class::DeploymentHandler::Cookbook::CustomResultSource - Customize how
your DBICDH versions are stored
=head1 AUTHOR
Arthur Axel "fREW" Schmidt
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
ExplicitVersions.pm 100644 001750 001750 6137 12217355667 33223 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler/VersionHandler package DBIx::Class::DeploymentHandler::VersionHandler::ExplicitVersions;
{
$DBIx::Class::DeploymentHandler::VersionHandler::ExplicitVersions::VERSION = '0.002208';
}
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
__END__
=pod
=head1 NAME
DBIx::Class::DeploymentHandler::VersionHandler::ExplicitVersions - Define your own list of versions to use for migrations
=head1 SEE ALSO
This class is an implementation of
L. Pretty much all the
documentation is there.
=head1 AUTHOR
Arthur Axel "fREW" Schmidt
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
Standard 000755 001750 001750 0 12217355667 30773 5 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler/VersionStorage Component.pm 100644 001750 001750 3335 12217355667 33437 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard package DBIx::Class::DeploymentHandler::VersionStorage::Standard::Component;
{
$DBIx::Class::DeploymentHandler::VersionStorage::Standard::Component::VERSION = '0.002208';
}
# 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
__END__
=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
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
Deprecated 000755 001750 001750 0 12217355667 31273 5 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler/VersionStorage Component.pm 100644 001750 001750 4022 12217355667 33731 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated package DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::Component;
{
$DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::Component::VERSION = '0.002208';
}
# 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
__END__
=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.
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
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
VersionResult.pm 100644 001750 001750 2702 12217355667 34316 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard package DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult;
{
$DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult::VERSION = '0.002208';
}
# 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
__END__
=pod
=head1 NAME
DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult - The typical way to store versions in the database
=head1 AUTHOR
Arthur Axel "fREW" Schmidt
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
Translator 000755 001750 001750 0 12217355667 31446 5 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL Deprecated.pm 100644 001750 001750 6535 12217355667 34215 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator package DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::Deprecated;
{
$DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::Deprecated::VERSION = '0.002208';
}
use Moose;
# ABSTRACT: (DEPRECATED) Use this if you are stuck in the past
use File::Spec::Functions;
extends 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator';
sub _ddl_schema_consume_filenames {
my ($self, $type, $version) = @_;
return [$self->_ddl_schema_produce_filename($type, $version)]
}
sub _ddl_schema_produce_filename {
my ($self, $type, $version) = @_;
my $filename = ref $self->schema;
$filename =~ s/::/-/g;
$filename = catfile(
$self->script_directory, "$filename-$version-$type.sql"
);
return $filename;
}
sub _ddl_schema_up_produce_filename {
my ($self, $type, $versions, $dir) = @_;
my $filename = ref $self->schema;
$filename =~ s/::/-/g;
$filename = catfile(
$self->script_directory, "$filename-" . join( q(-), @{$versions} ) . "-$type.sql"
);
return $filename;
}
sub _ddl_schema_up_consume_filenames {
my ($self, $type, $versions) = @_;
return [$self->_ddl_schema_up_produce_filename($type, $versions)]
}
__PACKAGE__->meta->make_immutable;
1;
# vim: ts=2 sw=2 expandtab
__END__
=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 so that the files generated with
L will work with this out of the box.
=head1 DEPRECATED
I begrudgingly made this module (and other related modules) to keep porting
from L relatively simple. I will make changes
to ensure that it works with output from L 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
=item *
L
=item *
L
=item *
L
=back
=head1 SEE ALSO
This class is an implementation of
L. Pretty much all the
documentation is there.
=head1 AUTHOR
Arthur Axel "fREW" Schmidt
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
VersionResult.pm 100644 001750 001750 3047 12217355667 34621 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated package DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::VersionResult;
{
$DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::VersionResult::VERSION = '0.002208';
}
# 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
__END__
=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.
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
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
DatabaseToSchemaVersions.pm 100644 001750 001750 3511 12217355667 34563 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler/VersionHandler package DBIx::Class::DeploymentHandler::VersionHandler::DatabaseToSchemaVersions;
{
$DBIx::Class::DeploymentHandler::VersionHandler::DatabaseToSchemaVersions::VERSION = '0.002208';
}
use Moose;
# ABSTRACT: Go straight from Database to Schema version
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
__END__
=pod
=head1 NAME
DBIx::Class::DeploymentHandler::VersionHandler::DatabaseToSchemaVersions - Go straight from Database to Schema version
=head1 SEE ALSO
This class is an implementation of
L. Pretty much all the
documentation is there.
=head1 AUTHOR
Arthur Axel "fREW" Schmidt
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
VersionResultSet.pm 100644 001750 001750 2376 12217355667 35001 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard package DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResultSet;
{
$DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResultSet::VERSION = '0.002208';
}
# 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->count; 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
__END__
=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
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
ScriptHelpers.pm 100644 001750 001750 10431 12217355667 34752 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator package DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::ScriptHelpers;
{
$DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::ScriptHelpers::VERSION = '0.002208';
}
use strict;
use warnings;
use Sub::Exporter::Progressive -setup => {
exports => [qw(dbh schema_from_schema_loader)],
};
use List::Util 'first';
use Text::Brew 'distance';
use Try::Tiny;
use DBIx::Class::DeploymentHandler::LogImporter qw(:dlog);
sub dbh {
my ($code) = @_;
sub {
my ($schema, $versions) = @_;
$schema->storage->dbh_do(sub {
$code->($_[1], $versions)
})
}
}
sub _rearrange_connect_info {
my ($storage) = @_;
my $nci = $storage->_normalize_connect_info($storage->connect_info);
return {
dbh_maker => sub { $storage->dbh },
map %{$nci->{$_}}, grep { $_ ne 'arguments' } keys %$nci,
};
}
my $count = 0;
sub schema_from_schema_loader {
my ($opts, $code) = @_;
die 'schema_from_schema_loader requires options!'
unless $opts && ref $opts && ref $opts eq 'HASH';
die 'schema_from_schema_loader requires naming settings to be set!'
unless $opts->{naming};
warn 'using "current" naming in a deployment script is begging for problems. Just Say No.'
if $opts->{naming} eq 'current' ||
(ref $opts->{naming} eq 'HASH' && first { $_ eq 'current' } values %{$opts->{naming}});
$opts->{debug} = 1
if !exists $opts->{debug} && $ENV{DBICDH_TRACE};
sub {
my ($schema, $versions) = @_;
require DBIx::Class::Schema::Loader;
$schema->storage->ensure_connected;
my @ci = _rearrange_connect_info($schema->storage);
my $new_schema = DBIx::Class::Schema::Loader::make_schema_at(
'SHSchema::' . $count++, $opts, \@ci
);
Dlog_debug {
"schema_from_schema_loader generated the following sources: $_"
} [ $new_schema->sources ];
my $sl_schema = $new_schema->connect(@ci);
try {
$code->($sl_schema, $versions)
} catch {
if (m/Can't find source for (.+?) at/) {
my @presentsources = map {
(distance($_, $1))[0] < 3 ? "$_ <== Possible Match\n" : "$_\n";
} $sl_schema->sources;
die <<"ERR";
$_
You are seeing this error because the DBIx::Class::ResultSource in your
migration script called "$1" is not part of the schema that ::Schema::Loader
has inferred from your existing database.
To help you debug this issue, here's a list of the actual sources that the
schema available to your migration knows about:
@presentsources
ERR
}
die $_;
}
}
}
1;
__END__
=pod
=head1 NAME
DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::ScriptHelpers
=head1 SYNOPSIS
use DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::ScriptHelpers
'schema_from_schema_loader';
schema_from_schema_loader({ naming => 'v4' }, sub {
my ($schema, $version_set) = @_;
...
});
=head1 DESCRIPTION
This package is a set of coderef transforms for common use-cases in migrations.
The subroutines are simply helpers for creating coderefs that will work for
L,
yet have some argument other than the current schema that you as a user might
prefer.
=head1 EXPORTED SUBROUTINES
=head2 dbh($coderef)
dbh(sub {
my ($dbh, $version_set) = @_;
...
});
For those times when you almost exclusively need access to "the bare metal".
Simply gives you the correct database handle and the expected version set.
=head2 schema_from_schema_loader($sl_opts, $coderef)
schema_from_schema_loader({ naming => 'v4' }, sub {
my ($schema, $version_set) = @_;
...
});
Any time you write a perl migration script that uses a L
you should probably use this. Otherwise you'll run into problems if you remove
a column from your schema yet still populate to it in an older population
script.
Note that C<$sl_opts> requires that you specify something for the C
option.
=head1 AUTHOR
Arthur Axel "fREW" Schmidt
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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
VersionResultSet.pm 100644 001750 001750 4174 12217355667 35277 0 ustar 00frew frew 000000 000000 DBIx-Class-DeploymentHandler-0.002208/lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated package DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::VersionResultSet;
{
$DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::VersionResultSet::VERSION = '0.002208';
}
# 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->count; 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
__END__
=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.
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 to the current time. (take a look, it's yucky)
=head1 AUTHOR
Arthur Axel "fREW" Schmidt
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 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