DBIx-Class-DeploymentHandler-0.002234 000755 001750 001750 0 14645756343 16011 5 ustar 00wes wes 000000 000000 TODO 100644 001750 001750 652 14645756343 16545 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234 * Serialize generated DDL (https://github.com/frioux/DBIx-Class-DeploymentHandler/issues/11)
* Refactor code to only optionally require DBIC (https://github.com/frioux/DBIx-Class-DeploymentHandler/issues/10)
* Factor out MigrationStorage (https://github.com/frioux/DBIx-Class-DeploymentHandler/issues/9)
* Remove the Deprecated options and add Migrations (https://github.com/frioux/DBIx-Class-DeploymentHandler/issues/31)
README 100644 001750 001750 23471 14645756343 17001 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234 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_deploy;
$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.
ATTRIBUTES
This is just a "stub" section to make clear that the bulk of
implementation is documented somewhere else.
Attributes passed to DBIx::Class::DeploymentHandler::HandlesDeploy
* "ignore_ddl" in
DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator
* "databases" in
DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator
* "script_directory" in
DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator
* "sql_translator_args" in
DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator
* "force_overwrite" in
DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator
* "txn_prep" in
DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator
* "txn_wrap" in
DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator
Attributes passed to DBIx::Class::DeploymentHandler::HandlesVersioning
* initial_version
* "schema_version" in DBIx::Class::DeploymentHandler::Dad
* "to_version" in DBIx::Class::DeploymentHandler::Dad
Attributes passed to DBIx::Class::DeploymentHandler::HandlesVersionStorage
* version_source
* version_class
Attributes Inherited from Parent Class
See "ATTRIBUTES" in DBIx::Class::DeploymentHandler::Dad and "ORTHODOX
METHODS" in DBIx::Class::DeploymentHandler::Dad for the remaining
available attributes to pass to "new".
WHERE IS ALL THE DOC?!
To get up and running fast, your best place to start is
DBIx::Class::DeploymentHandler::Manual::Intro and then
DBIx::Class::DeploymentHandler::Manual::CatalystIntro if your intending
on using this with Catalyst.
For the full story you should realise that
"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.
WHY IS THIS SO WEIRD
"DBIx::Class::DeploymentHandler" has a strange structure. The gist is
that it delegates to three small objects that are proxied to via
interface roles that then create the illusion of one large, monolithic
object. Here is a diagram that might help:
Figure 1
+------------+
| |
+------------+ Deployment +-----------+
| | Handler | |
| | | |
| +-----+------+ |
| | |
| | |
: : :
v v v
/-=-------\ /-=-------\ /-=----------\
| | | | | | (interface roles)
| Handles | | Handles | | Handles |
| Version | | Deploy | | Versioning |
| Storage | | | | |
| | \-+--+--+-/ \-+---+---+--/
\-+--+--+-/ | | | | | |
| | | | | | | | |
| | | | | | | | |
v v v v v v v v v
+----------+ +--------+ +-----------+
| | | | | | (implementations)
| Version | | Deploy | | Version |
| Storage | | Method | | Handler |
| Standard | | SQLT | | Monotonic |
| | | | | |
+----------+ +--------+ +-----------+
The nice thing about this is that we have well defined interfaces for
the objects that comprise the "DeploymentHandler", the smaller objects
can be tested in isolation, and the smaller objects can even be swapped
in easily. But the real win is that you can subclass the
"DeploymentHandler" without knowing about the underlying delegation; you
just treat it like normal Perl and write methods that do what you want.
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
This is just a "stub" section to make clear that the bulk of
implementation is documented in DBIx::Class::DeploymentHandler::Dad.
Since that is implemented using Moose class, see "ATTRIBUTES" in
DBIx::Class::DeploymentHandler::Dad and "ORTHODOX METHODS" in
DBIx::Class::DeploymentHandler::Dad for methods callable on the
resulting object.
new
my $s = My::Schema->connect(...);
my $dh = DBIx::Class::DeploymentHandler->new({
schema => $s,
databases => 'SQLite',
sql_translator_args => { add_drop_table => 0 },
});
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) 2024 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 26322 14645756343 17412 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234 Revision history for DBIx-Class-DeploymentHandler
0.002234 2024-07-17 10:01:51-05:00 America/Chicago
- Fix SQL::Translator producer_args deprecation warning #77 - thanks
@paultcochrane
0.002233 2019-09-25 13:32:11-04:00 America/New_York
- Add txn_wrap attribute to DBIC::DeploymentHandler
- Bugfix: Do not remove "false" transactions in deploy()
- use SQL::SplitStatement to split SQL statements in DDLs
- Add txn_prep attribute to keep backwards-compatibility
- Fixes GH #47, #68, #72 - thanks @augenslat
0.002232 2019-06-06 21:49:17-04:00 America/New_York
- Add missing dependency on YAML.pm
0.002231 2019-05-10 09:28:36-04:00 America/New_York
- Revert conversion to Moo; this code is now identical to v0.002224, with one
small fix from 0.002225, having to do with Pg chunk-splitting when there
is no semicolon
0.002230 2019-03-14 18:31:07+00:00 Europe/London
- MooX::Role::Parameterized forces min perl 5.010
0.002229 2019-03-14 18:13:25+00:00 Europe/London
- convert from Package::Variant to MooX::Role::Parameterized - fix #67
0.002228 2019-03-14 07:13:33+00:00 Europe/London
- IO::All dep to 0.87 in case causing Win32 problem
0.002227 2019-03-11 05:58:07+00:00 Europe/London
- test version-objects in 5.8-10 compatible way
0.002226 2019-03-11 03:14:04+00:00 Europe/London
- relax the Pg chunk-splitting when no ";"
- better test of version-object on schema
0.002225 2019-03-11 01:56:47+00:00 Europe/London
- convert to Type::Tiny
- Port to Moo
- convert parameterised role to Package::Variant
- convert file-handling to IO::All
0.002224 2019-03-09 05:16:47+00:00 Europe/London
- binmode on all filehandles so lines always end LF - thanks @wchristian
- more sophisticated SQL parsing handles Pg $$ stuff - thanks @mrenvoize
for report
0.002223 2019-03-07 01:36:36+00:00 Europe/London
- handle "package NAME VERSION" in a DBIx::Class::Schema - $VERSION
will be object
- add needed dep - thanks @wheinze
0.002222 2018-01-06 10:25:42-08:00 America/Los_Angeles
- Stop defaulting to include DROP TABLE, introduced by fix in prior release
(Fixes GH#59, thanks for the report Eugen Konkov!)
0.002221 2017-09-27 21:19:42-04:00 America/New_York
- Allow easy changing the version storage table name, which makes subclassing
much less painful (Thanks Andrew Gregory!)
- Above change renamed database_version => initial_version
- Fix args passed to SQL::Translator::Diff
- Add Michael McClimon as comaint
0.002220 2017-08-29 16:59:10-07:00 America/Los_Angeles
- generate short package names for scripts (Fixes GH#55)
(Thanks Andrew Gregory!)
- Fix args to internal method (Fixes GH#53)
(Thanks Alastair McGowan-Douglas!)
- Allow schema versions to be version objects (Fixes GH#51)
(Good find Jonathan Scott Duff!)
0.002219 2017-03-19 21:15:19-07:00 America/Los_Angeles
- Fix typo in docs (Thanks Aaron Crane) (Fixes GH#49)
- Fix spelling mistake in POD (Thanks Stefan Hornburg!)
- Add links to ::Intro from the docs (Thanks Martin Renvoize!)
0.002218 2015-10-31 16:35:26-07:00 America/Los_Angeles
- Fix spelling mistake in POD (Thanks Gregor Herrmann!)
0.002217 2015-10-04 15:05:01-07:00 America/Los_Angeles
- Document Custom Script Helper pattern
0.002216 2015-06-14 09:34:57-07:00 America/Los_Angeles
- Use Pod::Weaver::Plugin::Ditaa to render diagram
0.002215 2015-01-10 13:58:10-06:00 America/Chicago
- Improve documentation for how to portably create indices
(Thanks Meredith Howard for the ideas!)
0.002214 2014-12-21 11:53:20-06:00 America/Chicago
- Fix inconsistency of what files get run when `ignore_ddl` is set.
To be clear, if in the past you generated DDL and *also* hand wrote DDL,
`ignore_ddl` would ignore both, though the intention was only to ignore
generated DDL.
(Thanks Lianna Eeftinck for very detailed bug report at GH#20!)
- Include the filename of the script being run in case of error
- Add some documentation for how to portably create indices
- Fix doc bug stating that install calls initialize
(Thanks Gavin Shelley! Fixes GH#13)
- Minor Pod Fixes (Thanks Renee B and Pär Karlsson!)
0.002213 2014-12-03 08:44:10-06:00 America/Chicago
- Fix some POD formatting
0.002212 2014-10-11 15:04:22-05:00 America/Chicago
- Add some nice documentation on overall structure
0.002211 2014-05-15 20:06:48-05:00 America/Chicago
- Fix some missing ABSTRACTs (Fixes GH#22, thanks Gregor Herrmann!)
0.002210 2014-01-31 09:35:27 America/Chicago
- Make source order stable to avoid non-changes in git (fixes RT#92580)
- Ensure that sqltargs are passed to deploy when ignore_ddl is set
(fixes RT#92373)
- Correctly strip lines that are all whitespace (fixes RT#92582)
- Ditch RT
0.002209 2013-12-27 18:08:31 America/Chicago
- stop using Class::MOP::load_class (RT#91003)
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 46501 14645756343 17125 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234 This software is copyright (c) 2024 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) 2024 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, Fifth Floor, Boston, MA 02110-1301 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 Perl Artistic License 1.0 ---
This software is Copyright (c) 2024 by Arthur Axel "fREW" Schmidt.
This is free software, licensed under:
The Perl 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 as specified below.
"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 uunet.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) give non-standard executables non-standard names, and clearly
document 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. You may embed this Package's interpreter within
an executable of yours (by linking); this shall be construed as a mere
form of aggregation, provided that the complete Standard Version of the
interpreter is so embedded.
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 whoever generated
them, and may be sold commercially, and may be aggregated with this
Package. If such scripts or library files are aggregated with this
Package via the so-called "undump" or "unexec" methods of producing a
binary executable image, then distribution of such an image shall
neither be construed as a distribution of this Package nor shall it
fall under the restrictions of Paragraphs 3 and 4, provided that you do
not represent such an executable image as a Standard Version of this
Package.
7. C subroutines (or comparably compiled subroutines in other
languages) supplied by you and linked into this Package in order to
emulate subroutines and variables of the language defined by this
Package shall not be considered part of this Package, but are the
equivalent of input as in Paragraph 6, provided these subroutines do
not change the language in any way that would cause it to fail the
regression tests for the language.
8. Aggregation of this Package with a commercial distribution is always
permitted provided that the use of this Package is embedded; that is,
when no overt attempt is made to make this Package's interfaces visible
to the end user of the commercial distribution. Such use shall not be
construed as a distribution of this Package.
9. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
The End
cpanfile 100644 001750 001750 1555 14645756343 17604 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234 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 'Module::Runtime' => 0.001;
requires 'Moose' => 1.0;
requires 'MooseX::Role::Parameterized' => 0.18;
requires 'Try::Tiny' => 0;
requires 'SQL::Translator' => 1.63;
requires 'Carp' => 0;
requires 'Carp::Clan' => 0;
requires 'Context::Preserve' => 0.01;
requires 'Sub::Exporter::Progressive' => 0;
requires 'Text::Brew' => 0.02;
requires 'YAML' => 0.66;
requires 'SQL::SplitStatement' => '1.00020';
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;
recommends 'DBIx::Class::Schema::Loader' => 0;
};
dist.ini 100644 001750 001750 674 14645756343 17525 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234 name = DBIx-Class-DeploymentHandler
author = Arthur Axel "fREW" Schmidt
license = Perl_5
copyright_holder = Arthur Axel "fREW" Schmidt
version = 0.002234
; authordep Pod::Weaver::Plugin::Ditaa
[NextRelease]
[@Git]
[@Filter]
-bundle = @Basic
-remove = Readme
[GithubMeta]
issues = 1
[MetaJSON]
[PickyPodWeaver]
[PkgVersion]
[Pod2Readme]
[PodSyntaxTests]
[Prereqs::FromCPANfile]
META.yml 100644 001750 001750 2516 14645756343 17347 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234 ---
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: '0'
dynamic_config: 0
generated_by: 'Dist::Zilla version 6.031, CPAN::Meta::Converter version 2.150010'
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'
Module::Runtime: '0.001'
Moose: '1'
MooseX::Role::Parameterized: '0.18'
Path::Class: '0.26'
SQL::SplitStatement: '1.00020'
SQL::Translator: '1.63'
Sub::Exporter::Progressive: '0'
Text::Brew: '0.02'
Try::Tiny: '0'
YAML: '0.66'
autodie: '0'
namespace::autoclean: '0'
parent: '0.225'
resources:
bugtracker: https://github.com/frioux/DBIx-Class-DeploymentHandler/issues
homepage: https://github.com/frioux/DBIx-Class-DeploymentHandler
repository: https://github.com/frioux/DBIx-Class-DeploymentHandler.git
version: '0.002234'
x_generated_by_perl: v5.38.2
x_serialization_backend: 'YAML::Tiny version 1.74'
x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later'
MANIFEST 100644 001750 001750 6341 14645756343 17227 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234 # This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.031.
Changes
LICENSE
MANIFEST
META.json
META.yml
Makefile.PL
README
TODO
cpanfile
dist.ini
lib/DBIx/Class/DeploymentHandler.pm
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/00-report-prereqs.t
t/02-instantiation-alt-result-class.t
t/02-instantiation-no-ddl-no-wrap.t
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-multiple-schemas.t
t/10-split-sql-chunk.t
t/20-version-table-rename.t
t/alt-result-class-lib/DBICDHAltTest.pm
t/alt-result-class-lib/DBICVersionAlt_v1.pm
t/alt-result-class-lib/DBICVersionAlt_v2.pm
t/alt-result-class-lib/DBICVersionAlt_v3.pm
t/alt-result-class-lib/DBICVersionAlt_v4.pm
t/author-pod-syntax.t
t/bugs/01-emailed-bug-01.t
t/customised.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_errors.t
t/deploy_methods/sql_translator_ignore_ddl.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/lib/SH.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/version-table-rename-lib/DBICDHTest.pm
t/version-table-rename-lib/DBICVersion_v1.pm
t/version-table-rename-lib/DBICVersion_v2.pm
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 4553 14645756343 17522 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234 {
"abstract" : "Extensible DBIx::Class deployment",
"author" : [
"Arthur Axel \"fREW\" Schmidt "
],
"dynamic_config" : 0,
"generated_by" : "Dist::Zilla version 6.031, CPAN::Meta::Converter version 2.150010",
"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" : "0"
}
},
"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",
"Module::Runtime" : "0.001",
"Moose" : "1",
"MooseX::Role::Parameterized" : "0.18",
"Path::Class" : "0.26",
"SQL::SplitStatement" : "1.00020",
"SQL::Translator" : "1.63",
"Sub::Exporter::Progressive" : "0",
"Text::Brew" : "0.02",
"Try::Tiny" : "0",
"YAML" : "0.66",
"autodie" : "0",
"namespace::autoclean" : "0",
"parent" : "0.225"
}
},
"test" : {
"recommends" : {
"DBIx::Class::Schema::Loader" : "0"
},
"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"
},
"homepage" : "https://github.com/frioux/DBIx-Class-DeploymentHandler",
"repository" : {
"type" : "git",
"url" : "https://github.com/frioux/DBIx-Class-DeploymentHandler.git",
"web" : "https://github.com/frioux/DBIx-Class-DeploymentHandler"
}
},
"version" : "0.002234",
"x_generated_by_perl" : "v5.38.2",
"x_serialization_backend" : "Cpanel::JSON::XS version 4.37",
"x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later"
}
weaver.ini 100644 001750 001750 370 14645756343 20044 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234 [@CorePrep]
[-Ditaa]
[Name]
[Region / prelude]
[Generic / SYNOPSIS]
[Generic / DESCRIPTION]
[Generic / OVERVIEW]
[Leftovers]
[Collect / ATTRIBUTES]
command = attr
[Collect / METHODS]
command = method
[Region / postlude]
[Authors]
[Legal]
lib 000755 001750 001750 0 14645756343 16743 5 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t SH.pm 100644 001750 001750 1000 14645756343 17742 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t/lib package SH;
use strict;
use warnings;
use DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::ScriptHelpers
dbh => { -as => '_old_dbh' },
schema_from_schema_loader => { -as => '_old_sfsl' };
use Sub::Exporter::Progressive -setup => {
exports => [qw(dbh schema_from_schema_loader)],
};
our $DBH_RAN_OUTTER;
our $DBH_RAN_INNER;
sub dbh {
my ($coderef) = @_;
$DBH_RAN_OUTTER = 1;
_old_dbh(sub {
my ($dbh) = @_;
$DBH_RAN_INNER = 1;
$coderef->(@_);
});
}
1;
Makefile.PL 100644 001750 001750 4512 14645756343 20046 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234 # This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.031.
use strict;
use warnings;
use ExtUtils::MakeMaker;
my %WriteMakefileArgs = (
"ABSTRACT" => "Extensible DBIx::Class deployment",
"AUTHOR" => "Arthur Axel \"fREW\" Schmidt ",
"CONFIGURE_REQUIRES" => {
"ExtUtils::MakeMaker" => 0
},
"DISTNAME" => "DBIx-Class-DeploymentHandler",
"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",
"Module::Runtime" => "0.001",
"Moose" => 1,
"MooseX::Role::Parameterized" => "0.18",
"Path::Class" => "0.26",
"SQL::SplitStatement" => "1.00020",
"SQL::Translator" => "1.63",
"Sub::Exporter::Progressive" => 0,
"Text::Brew" => "0.02",
"Try::Tiny" => 0,
"YAML" => "0.66",
"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.002234",
"test" => {
"TESTS" => "t/*.t t/bugs/*.t t/deploy_methods/*.t t/version_handlers/*.t t/version_storages/*.t"
}
);
my %FallbackPrereqs = (
"Carp" => 0,
"Carp::Clan" => 0,
"Context::Preserve" => "0.01",
"DBD::SQLite" => "1.35",
"DBIx::Class" => "0.08121",
"File::Temp" => 0,
"Log::Contextual" => "0.005005",
"Module::Runtime" => "0.001",
"Moose" => 1,
"MooseX::Role::Parameterized" => "0.18",
"Path::Class" => "0.26",
"SQL::SplitStatement" => "1.00020",
"SQL::Translator" => "1.63",
"Sub::Exporter::Progressive" => 0,
"Test::Fatal" => "0.006",
"Test::More" => "0.88",
"Test::Requires" => "0.06",
"Text::Brew" => "0.02",
"Try::Tiny" => 0,
"YAML" => "0.66",
"aliased" => 0,
"autodie" => 0,
"namespace::autoclean" => 0,
"parent" => "0.225"
);
unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
delete $WriteMakefileArgs{TEST_REQUIRES};
delete $WriteMakefileArgs{BUILD_REQUIRES};
$WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
}
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
WriteMakefile(%WriteMakefileArgs);
t 000755 001750 001750 0 14645756343 16175 5 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234 customised.t 100644 001750 001750 14211 14645756343 20720 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t # This test represents darkpan code that subclasses DH using the recommended
# method. Updates should make sure this doesn't break, since it breaks
# real-world code!
use strict;
use warnings;
use lib 't/lib';
use DBICDHTest;
use DBIx::Class::DeploymentHandler;
{
package DH;
use Moose;
has initial_version => (
is => 'ro',
lazy => 1,
builder => '_build_initial_version',
);
sub _build_initial_version { $_[0]->database_version }
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 version_source)],
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( initial_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'],
attributes_to_copy => [qw(version_source version_class)],
};
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;
}
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;
04-preconnect.t 100644 001750 001750 2163 14645756343 21105 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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;
03-deprecated.t 100644 001750 001750 5726 14645756343 21054 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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;
DBICDHTest.pm 100644 001750 001750 223 14645756343 21173 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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 14645756343 21634 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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;
00-report-prereqs.t 100644 001750 001750 13506 14645756343 21756 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t #!perl
use strict;
use warnings;
# This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.020
# THEN modified with more info by Ed J for PDL project
use Test::More tests => 1;
use ExtUtils::MakeMaker;
use File::Spec;
# from $version::LAX
my $lax_version_re =
qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )?
|
(?:\.[0-9]+) (?:_[0-9]+)?
) | (?:
v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )?
|
(?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)?
)
)/x;
# hide optional CPAN::Meta modules from prereq scanner
# and check if they are available
my $cpan_meta = "CPAN::Meta";
my $cpan_meta_pre = "CPAN::Meta::Prereqs";
my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic
# Verify requirements?
my $DO_VERIFY_PREREQS = 1;
sub _max {
my $max = shift;
$max = ( $_ > $max ) ? $_ : $max for @_;
return $max;
}
sub _merge_prereqs {
my ($collector, $prereqs) = @_;
# CPAN::Meta::Prereqs object
if (ref $collector eq $cpan_meta_pre) {
return $collector->with_merged_prereqs(
CPAN::Meta::Prereqs->new( $prereqs )
);
}
# Raw hashrefs
for my $phase ( keys %$prereqs ) {
for my $type ( keys %{ $prereqs->{$phase} } ) {
for my $module ( keys %{ $prereqs->{$phase}{$type} } ) {
$collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module};
}
}
}
return $collector;
}
my @include = qw(
);
my @exclude = qw(
);
# Add static prereqs to the included modules list
my $static_prereqs = do 't/00-report-prereqs.dd';
# Merge all prereqs (either with ::Prereqs or a hashref)
my $full_prereqs = _merge_prereqs(
( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ),
$static_prereqs
);
# Add dynamic prereqs to the included modules list (if we can)
my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml';
if ( $source && $HAS_CPAN_META ) {
if ( my $meta = eval { CPAN::Meta->load_file($source) } ) {
$full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs);
}
}
else {
$source = 'static metadata';
}
my @full_reports;
my @dep_errors;
my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs;
# Add static includes into a fake section
for my $mod (@include) {
$req_hash->{other}{modules}{$mod} = 0;
}
for my $phase ( qw(configure build test runtime develop other) ) {
next unless $req_hash->{$phase};
next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING});
for my $type ( qw(requires recommends suggests conflicts modules) ) {
next unless $req_hash->{$phase}{$type};
my $title = ucfirst($phase).' '.ucfirst($type);
my @reports = [qw/Module Want Have Where Howbig/];
for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) {
next if $mod eq 'perl';
next if grep { $_ eq $mod } @exclude;
my $file = $mod;
$file =~ s{::}{/}g;
$file .= ".pm";
my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC;
my $want = $req_hash->{$phase}{$type}{$mod};
$want = "undef" unless defined $want;
$want = "any" if !$want && $want == 0;
my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required";
if ($prefix) {
my $filename = File::Spec->catfile($prefix, $file);
my $have = MM->parse_version( $filename );
$have = "undef" unless defined $have;
push @reports, [$mod, $want, $have, $prefix, (-s $filename)];
if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) {
if ( $have !~ /\A$lax_version_re\z/ ) {
push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)";
}
elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) {
push @dep_errors, "$mod version '$have' is not in required range '$want'";
}
}
}
else {
push @reports, [$mod, $want, "missing", '', 0];
if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) {
push @dep_errors, "$mod is not installed ($req_string)";
}
}
}
if ( @reports ) {
push @full_reports, "=== $title ===\n\n";
my $ml = _max( map { length $_->[0] } @reports );
my $wl = _max( map { length $_->[1] } @reports );
my $hl = _max( map { length $_->[2] } @reports );
my $ll = _max( map { length $_->[3] } @reports ); # location
my $sl = _max( map { length $_->[4] } @reports ); # size
if ($type eq 'modules') {
splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl, "-" x $ll, "-" x $sl];
push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports;
}
else {
splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl, "-" x $ll, "-" x $sl];
push @full_reports, map { sprintf(" %*s %*s %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2], -$ll, $_->[3], $sl, $_->[4]) } @reports;
}
push @full_reports, "\n";
}
}
}
if ( @full_reports ) {
diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports;
}
if ( @dep_errors ) {
diag join("\n",
"\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n",
"The following REQUIRED prerequisites were not satisfied:\n",
@dep_errors,
"\n"
);
}
pass;
# vim: ts=4 sts=4 sw=4 et:
author-pod-syntax.t 100644 001750 001750 454 14645756343 22113 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t #!perl
BEGIN {
unless ($ENV{AUTHOR_TESTING}) {
print qq{1..0 # SKIP these tests are for testing by the author\n};
exit
}
}
# This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests.
use strict; use warnings;
use Test::More;
use Test::Pod 1.41;
all_pod_files_ok();
10-split-sql-chunk.t 100644 001750 001750 7561 14645756343 22007 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t use strict;
use warnings;
use 5.010;
use Test::More;
use DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator;
sub make_dm {
my $storage_class = shift;
bless {
storage => bless({}, 'DBIx::Class::Storage::DBI::'.$storage_class),
@_,
}, 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator';
}
my $dm = make_dm('mysql');
is_deeply [ $dm->_split_sql_chunk( <<'END' ) ], [ 'BEGIN SELECT * FROM YADAH END' ];
BEGIN
-- stuff
SELECT * FROM YADAH
END;
END
is_deeply [ $dm->_split_sql_chunk( 'foo', ' ', 'bar' ) ], [qw(foo bar)];
$dm = make_dm('mysql', txn_prep => 1); # default, bw-comp.
is_deeply [ $dm->_split_sql_chunk( <<'END' ) ],
BEGIN;
-- stuff
DELIMITER $$
insert into door (color) VALUES ('#f00')$$
SELECT * FROM YADAH$$
DELIMITER ;
Commit;
END
[
q(insert into door (color) VALUES ('#f00')),
'SELECT * FROM YADAH',
];
$dm = make_dm('mysql', txn_prep => 0);
is_deeply [ $dm->_split_sql_chunk( <<'END' ) ],
BEGIN;
-- stuff
DELIMITER $$
insert into door (color) VALUES ('#000')$$
SELECT * FROM YADAH$$
DELIMITER ;
Commit;
END
[
'BEGIN',
q(insert into door (color) VALUES ('#000')),
'SELECT * FROM YADAH',
'Commit',
];
$dm = make_dm('mysql', txn_prep => 0);
is_deeply [ $dm->_split_sql_chunk( <<'END' ) ],
insert into door (color) VALUES ('#000');
CREATE TRIGGER upd_check BEFORE UPDATE ON account
FOR EACH ROW
BEGIN
IF NEW.amount < 0 THEN
SET NEW.amount = 0;
ELSEIF NEW.amount > 100 THEN
SET NEW.amount = 100;
END IF;
END;
SELECT * FROM YADAH;
END
[
q(insert into door (color) VALUES ('#000')),
'CREATE TRIGGER upd_check BEFORE UPDATE ON account FOR EACH ROW BEGIN IF NEW.amount < 0 THEN SET NEW.amount = 0; ELSEIF NEW.amount > 100 THEN SET NEW.amount = 100; END IF; END',
'SELECT * FROM YADAH',
];
$dm = make_dm('Pg');
is_deeply [ $dm->_split_sql_chunk( <<'END' ) ],
-- Add triggers to maintain sync between list_material_ratings table and list_materials table:;
CREATE FUNCTION add_rating() RETURNS trigger AS $add_rating$
BEGIN
IF NEW."type" = 'like' THEN
UPDATE "list_materials" SET "likes" = (SELECT COUNT(*) FROM "list_material_ratings" WHERE "list" = NEW."list" AND "material" = NEW."material" AND "type" = 'like') WHERE "list" = NEW."list" AND "material" = NEW."material";
END IF;
IF NEW."type" = 'dislike' THEN
UPDATE "list_materials" SET "dislikes" = (SELECT COUNT(*) FROM "list_material_ratings" WHERE "list" = NEW."list" AND "material" = NEW."material" AND "type" = 'dislike') WHERE "list" = NEW."list" AND "material" = NEW."material";
END IF;
RETURN NULL;
END;
$add_rating$ LANGUAGE plpgsql;
END
[ q{CREATE FUNCTION add_rating() RETURNS trigger AS $add_rating$ BEGIN IF NEW."type" = 'like' THEN UPDATE "list_materials" SET "likes" = (SELECT COUNT(*) FROM "list_material_ratings" WHERE "list" = NEW."list" AND "material" = NEW."material" AND "type" = 'like') WHERE "list" = NEW."list" AND "material" = NEW."material"; END IF; IF NEW."type" = 'dislike' THEN UPDATE "list_materials" SET "dislikes" = (SELECT COUNT(*) FROM "list_material_ratings" WHERE "list" = NEW."list" AND "material" = NEW."material" AND "type" = 'dislike') WHERE "list" = NEW."list" AND "material" = NEW."material"; END IF; RETURN NULL; END; $add_rating$ LANGUAGE plpgsql} ];
$dm = make_dm('Pg');
is_deeply [ $dm->_split_sql_chunk( <<'END' ) ],
CREATE TABLE "dbix_class_deploymenthandler_versions" ( "id" serial NOT NULL, "version" character varying(50) NOT NULL, "ddl" text, "upgrade_sql" text, PRIMARY KEY ("id"), CONSTRAINT "dbix_class_deploymenthandler_versions_version" UNIQUE ("version") )
END
[ q{CREATE TABLE "dbix_class_deploymenthandler_versions" ( "id" serial NOT NULL, "version" character varying(50) NOT NULL, "ddl" text, "upgrade_sql" text, PRIMARY KEY ("id"), CONSTRAINT "dbix_class_deploymenthandler_versions_version" UNIQUE ("version") )} ];
done_testing;
10-multiple-schemas.t 100644 001750 001750 4164 14645756343 22221 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t #!perl
use strict;
use warnings;
use lib 't/lib';
use lib 't/alt-result-class-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_ok 'DBICVersion_v1';
$DBICVersion::Schema::VERSION = 1;
use_ok 'DBICVersionAlt_v2';
$DBICVersionAlt::Schema::VERSION = 2;
my $dbh = DBICDHTest::dbh();
my @connection = (sub { $dbh }, { ignore_version => 1 });
my $sql_dir = tempdir( CLEANUP => 1 );
my $s1 = DBICVersion::Schema->connect(@connection);
ok($s1, 'DBICVersion::Schema 1 instantiates correctly');
my $s2 = DBICVersionAlt::Schema->connect(@connection);
ok($s2, 'DBICVersionAlt::Schema 2 instantiates correctly');
my $handler1 = DH->new({
script_directory => "$sql_dir/dh",
schema => $s1,
databases => 'SQLite',
sql_translator_args => { add_drop_table => 0 },
});
ok($handler1, 'DBIx::Class::DeploymentHandler w/1 instantiates correctly');
my $handler2 = DH->new({
script_directory => "$sql_dir/dh-alt",
schema => $s2,
databases => 'SQLite',
version_source => 'DBICDHVersionAlt',
version_class => 'DBICVersionAlt::Version',
sql_translator_args => { add_drop_table => 0 },
});
ok($handler2, 'DBIx::Class::DeploymentHandler w/2 instantiates correctly');
STANDARD: {
my $version = $s1->schema_version;
$handler1->prepare_install;
dies_ok {
$s1->resultset('Foo')->create({
bar => 'frew',
})
} 'schema not deployed';
$handler1->install({ version => 1 });
lives_ok {
$s1->resultset('Foo')->create({
bar => 'frew',
})
} 'schema is deployed';
}
ALT: {
my $version = $s2->schema_version();
$handler2->prepare_install;
dies_ok {
$s2->resultset('Foo')->create({
bar => 'frew',
baz => 'frew',
})
} 'schema not deployed';
$handler2->install({ version => 2 });
lives_ok {
$s2->resultset('Foo')->create({
bar => 'frew',
baz => 'frew',
})
} 'schema is deployed';
}
is($handler1->database_version, 1, 'schema 1 version correctly set');
is($handler2->database_version, 2, 'schema 2 version correctly set');
done_testing;
DBICVersion_v4.pm 100644 001750 001750 1174 14645756343 22124 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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 14645756343 22113 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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_v3.pm 100644 001750 001750 1311 14645756343 22114 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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;
DBICVersion_v2.pm 100644 001750 001750 1174 14645756343 22122 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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;
bugs 000755 001750 001750 0 14645756343 17135 5 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t 01-emailed-bug-01.t 100644 001750 001750 2062 14645756343 22271 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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 10657 14645756343 23031 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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');
$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');
$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');
$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');
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';
}
DOWN1: {
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 => [],
txn_prep => 0,
});
ok($handler, 'DBIx::Class::DeploymentHandler w/1 instantiates correctly');
lives_ok {
$s->resultset('Foo')->create({
bar => 'frew',
baz => 'frew',
})
} 'schema at version 2';
$handler->downgrade;
dies_ok {
$s->resultset('Foo')->create({
bar => 'frew',
baz => 'frew',
})
} 'schema not at version 2';
lives_ok {
$s->resultset('Foo')->create({
bar => 'frew',
})
} 'schema is at version 1';
is $handler->version_storage->database_version => 1,
'database version is down to 1';
}
done_testing;
20-version-table-rename.t 100644 001750 001750 4710 14645756343 22762 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t #!perl
use strict;
use warnings;
use lib 't/version-table-rename-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;
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;
$s->unregister_source('__VERSION'); # remove leftover version source
ok($s, 'DBICVersion::Schema 2 instantiates correctly');
my $handler = DH->new({
initial_version => 1,
script_directory => $sql_dir,
schema => $s,
databases => 'SQLite',
version_source => 'DBICDHVersion',
version_class => 'DBICVersion::Version',
});
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} );
# manually add SQL to rename the version table
open(my $fh, '>', "$sql_dir/SQLite/upgrade/1-2/002-version-table-rename.sql")
or die "unable to open '$sql_dir/SQLite/upgrade/1-2/002-version-table-rename.sql' ($!)";
print {$fh} <resultset('Foo')->create({
bar => 'frew',
baz => 'frew',
})
} 'schema not deployed';
$handler->upgrade;
lives_ok {
$s->resultset('Foo')->create({
bar => 'frew',
baz => 'frew',
})
} 'schema is deployed';
is $handler->database_version, 2, 'correct schema version is set';
}
done_testing;
version_storages 000755 001750 001750 0 14645756343 21571 5 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t standard.t 100644 001750 001750 5334 14645756343 23723 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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 File::Find;
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' );
my @resulting_files;
find(sub { -f and push @resulting_files, $File::Find::name }, $sql_dir);
for (@resulting_files) {
my $contents = do {
local $/;
open my $fh, $_ or die;
binmode $fh, ':raw';
<$fh>
};
is index($contents, "\015\012"), -1, "$_ no CRLF";
}
done_testing;
version_handlers 000755 001750 001750 0 14645756343 21542 5 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t monotonic.t 100644 001750 001750 5674 14645756343 24110 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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';
SKIP: {
skip 'no "version" installed', 1 if !eval { require version; 1 };
lives_ok { Monotonic->new({
schema_version => version->declare("2.0"),
database_version => 1,
}) } 'version-obj Ok';
}
{
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 14645756343 21355 5 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t DBICDHTest.pm 100644 001750 001750 211 14645756343 23602 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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 14645756343 24267 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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 14645756343 21214 5 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t sql_translator.t 100644 001750 001750 17243 14645756343 24640 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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
script-helpers.t 100644 001750 001750 6705 14645756343 24515 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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 SH dbh => { -as => 'alternate_dbh'};
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 'custom script helpers' => sub {
my $ran;
ok !$SH::DBH_RAN_OUTTER, 'alternate_dbh has ...';
ok !$SH::DBH_RAN_INNER, '... not run yet';
alternate_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';
ok $SH::DBH_RAN_OUTTER, 'alternate_dbh has ...';
ok $SH::DBH_RAN_INNER, '... run correctly';
};
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;
coderef-leakage.t 100644 001750 001750 1705 14645756343 24542 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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 }
02-instantiation-no-ddl-no-wrap.t 100644 001750 001750 7435 14645756343 24372 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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 },
txn_wrap => 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 => [],
txn_wrap => 0,
});
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 => [],
txn_wrap => 0,
});
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 => [],
txn_wrap => 0,
});
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;
Class 000755 001750 001750 0 14645756343 20333 5 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx DeploymentHandler.pm 100644 001750 001750 110743 14645756343 24515 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class package DBIx::Class::DeploymentHandler;
$DBIx::Class::DeploymentHandler::VERSION = '0.002234';
# ABSTRACT: Extensible DBIx::Class deployment
use Moose;
has initial_version => (is => 'ro', lazy_build => 1);
sub _build_initial_version { $_[0]->database_version }
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 version_source)],
attributes_to_copy => [qw(
ignore_ddl databases script_directory sql_translator_args force_overwrite txn_prep txn_wrap
)],
},
'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( initial_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'],
attributes_to_copy => [qw(version_source version_class)],
};
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_deploy;
$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 ATTRIBUTES
This is just a "stub" section to make clear
that the bulk of implementation is documented somewhere else.
=head2 Attributes passed to L
=over
=item *
L
=item *
L
=item *
L
=item *
L
=item *
L
=item *
L
=item *
L
=back
=head2 Attributes passed to L
=over
=item *
initial_version
=item *
L
=item *
L
=back
=head2 Attributes passed to L
=over
=item *
version_source
=item *
version_class
=back
=head2 Attributes Inherited from Parent Class
See L and
L for the remaining
available attributes to pass to C.
=head1 WHERE IS ALL THE DOC?!
To get up and running fast, your best place to start is
L and then
L if your intending on
using this with Catalyst.
For the full story you should realise that 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 WHY IS THIS SO WEIRD
C has a strange structure. The gist is that it
delegates to three small objects that are proxied to via interface roles that
then create the illusion of one large, monolithic object. Here is a diagram
that might help:
=begin text
Figure 1
+------------+
| |
+------------+ Deployment +-----------+
| | Handler | |
| | | |
| +-----+------+ |
| | |
| | |
: : :
v v v
/-=-------\ /-=-------\ /-=----------\
| | | | | | (interface roles)
| Handles | | Handles | | Handles |
| Version | | Deploy | | Versioning |
| Storage | | | | |
| | \-+--+--+-/ \-+---+---+--/
\-+--+--+-/ | | | | | |
| | | | | | | | |
| | | | | | | | |
v v v v v v v v v
+----------+ +--------+ +-----------+
| | | | | | (implementations)
| Version | | Deploy | | Version |
| Storage | | Method | | Handler |
| Standard | | SQLT | | Monotonic |
| | | | | |
+----------+ +--------+ +-----------+
=end text
=for html Figure 1
The nice thing about this is that we have well defined interfaces for the
objects that comprise the C, the smaller objects can be
tested in isolation, and the smaller objects can even be swapped in easily. But
the real win is that you can subclass the C without knowing
about the underlying delegation; you just treat it like normal Perl and write
methods that do what you want.
=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
This is just a "stub" section to make clear
that the bulk of implementation is documented in
L. Since that is implemented using
L class, see L
and L for methods
callable on the resulting object.
=head2 new
my $s = My::Schema->connect(...);
my $dh = DBIx::Class::DeploymentHandler->new({
schema => $s,
databases => 'SQLite',
sql_translator_args => { add_drop_table => 0 },
});
=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) 2024 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 14645756343 24530 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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 14645756343 24513 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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 14645756343 24531 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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 14645756343 24526 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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;
02-instantiation-alt-result-class.t 100644 001750 001750 11342 14645756343 25043 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t #!perl
use strict;
use warnings;
use lib 't/alt-result-class-lib';
use DBICDHAltTest;
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 = DBICDHAltTest::dbh();
my @connection = (sub { $dbh }, { ignore_version => 1 });
my $sql_dir = tempdir( CLEANUP => 1 );
VERSION1: {
use_ok 'DBICVersionAlt_v1';
my $s = DBICVersionAlt::Schema->connect(@connection);
$DBICVersionAlt::Schema::VERSION = 1;
ok($s, 'DBICVersionAlt::Schema 1 instantiates correctly');
my $handler = DH->new({
script_directory => $sql_dir,
schema => $s,
databases => 'SQLite',
version_source => 'DBICDHVersionAlt',
version_class => 'DBICVersionAlt::Version',
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 'DBICVersionAlt_v2';
my $s = DBICVersionAlt::Schema->connect(@connection);
$DBICVersionAlt::Schema::VERSION = 2;
subtest 'bug deploying first version' => sub {
my $dbh = DBICDHAltTest::dbh();
my @connection = (sub { $dbh }, { ignore_version => 1 });
my $s = DBICVersionAlt::Schema->connect(@connection);
my $handler = DH->new({
script_directory => $sql_dir,
schema => $s,
databases => 'SQLite',
version_source => 'DBICDHVersion',
version_class => 'DBICVersionAlt::Version',
});
$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',
version_source => 'DBICDHVersion',
version_class => 'DBICVersionAlt::Version',
});
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 'DBICVersionAlt_v3';
my $s = DBICVersionAlt::Schema->connect(@connection);
$DBICVersionAlt::Schema::VERSION = 3;
ok($s, 'DBICVersionAlt::Schema 3 instantiates correctly');
my $handler = DH->new({
script_directory => $sql_dir,
schema => $s,
databases => 'SQLite',
version_source => 'DBICDHVersion',
version_class => 'DBICVersionAlt::Version',
});
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 'DBICVersionAlt_v4';
my $s = DBICVersionAlt::Schema->connect(@connection);
$DBICVersionAlt::Schema::VERSION = 2;
ok($s, 'DBICVersionAlt::Schema 2 instantiates correctly');
my $handler = DH->new({
script_directory => $sql_dir,
schema => $s,
databases => 'SQLite',
version_source => 'DBICDHVersionAlt',
version_class => 'DBICVersionAlt::Version',
});
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;
explict_versions.t 100644 001750 001750 6232 14645756343 25472 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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
alt-result-class-lib 000755 001750 001750 0 14645756343 22140 5 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t DBICDHAltTest.pm 100644 001750 001750 214 14645756343 25031 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t/alt-result-class-lib package DBICDHAltTest;
use strict;
use warnings;
sub dbh {
DBI->connect('dbi:SQLite::memory:', undef, undef, { RaiseError => 1 })
}
1;
db_schema_versions.t 100644 001750 001750 3042 14645756343 25723 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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
DeploymentHandler 000755 001750 001750 0 14645756343 23751 5 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class Dad.pm 100644 001750 001750 15536 14645756343 25171 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::Dad;
$DBIx::Class::DeploymentHandler::Dad::VERSION = '0.002234';
# 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 {
my $version = $_[0]->schema_version;
ref($version) ? $version->numify : $version;
}
has schema_version => (
is => 'ro',
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) 2024 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_errors.t 100644 001750 001750 2715 14645756343 26212 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t/deploy_methods #!perl
use strict;
use warnings;
use Test::More;
use Test::Fatal qw(dies_ok exception);
use lib 't/lib';
use DBICDHTest;
use aliased 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator';
use Path::Class qw(dir file);
use File::Temp qw(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 },
});
ok( $dm, 'DBIC::DH::DM::SQL::Translator gets instantiated correctly' );
my $lethal_perl = file($sql_dir, 'SQLite', 'deploy', qw(1.0 000-foo.pl ));
dir($sql_dir, 'SQLite', 'deploy', '1.0')->mkpath;
{
open my $fh, '>', $lethal_perl;
print {$fh} 'sub {die "test"}';
close $fh;
}
like exception {
$dm->deploy;
}, qr(Perl in .*SQLite[/\\]deploy[/\\]1\.0[/\\]000-foo\.pl), 'file prepended to Perl script error';
unlink "$lethal_perl";
open my $fh, '>',
file($sql_dir, 'SQLite', 'deploy', qw(1.0 000-bar.sql ));
print {$fh} 'INVALID SQL;';
close $fh;
like exception {
$dm->deploy;
}, qr(SQL in .*SQLite[/\\]deploy[/\\]1\.0[/\\]000-bar\.sql), 'file prepended to SQL script error';
}
done_testing;
#vim: ts=2 sw=2 expandtab
version-table-rename-lib 000755 001750 001750 0 14645756343 22760 5 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t DBICDHTest.pm 100644 001750 001750 223 14645756343 25210 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t/version-table-rename-lib package DBICDHTest;
use strict;
use warnings;
use DBI;
sub dbh {
DBI->connect('dbi:SQLite::memory:', undef, undef, { RaiseError => 1 })
}
1;
Types.pm 100644 001750 001750 2034 14645756343 25552 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::Types;
$DBIx::Class::DeploymentHandler::Types::VERSION = '0.002234';
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 'DBIx::Class::DeploymentHandler::VersionNonObj'
=> as 'Str';
coerce 'DBIx::Class::DeploymentHandler::VersionNonObj'
=> from 'Object'
=> via { $_->numify };
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) 2024 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 2121 14645756343 25662 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::Logger;
$DBIx::Class::DeploymentHandler::Logger::VERSION = '0.002234';
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;
DBICVersionAlt_v4.pm 100644 001750 001750 1415 14645756343 25760 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t/alt-result-class-lib package DBICVersionAlt::Foo;
use base 'DBIx::Class::Core';
use strict;
use warnings;
__PACKAGE__->table('FooAlt');
__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 DBICVersionAlt::Version;
use base 'DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult';
use strict;
use warnings;
__PACKAGE__->table('dbic_version');
package DBICVersionAlt::Schema;
use base 'DBIx::Class::Schema';
use strict;
use warnings;
our $VERSION = '2.0';
__PACKAGE__->register_class('Foo', 'DBICVersionAlt::Foo');
1;
DBICVersionAlt_v2.pm 100644 001750 001750 1415 14645756343 25756 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t/alt-result-class-lib package DBICVersionAlt::Foo;
use base 'DBIx::Class::Core';
use strict;
use warnings;
__PACKAGE__->table('FooAlt');
__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 DBICVersionAlt::Version;
use base 'DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult';
use strict;
use warnings;
__PACKAGE__->table('dbic_version');
package DBICVersionAlt::Schema;
use base 'DBIx::Class::Schema';
use strict;
use warnings;
our $VERSION = '2.0';
__PACKAGE__->register_class('Foo', 'DBICVersionAlt::Foo');
1;
DBICVersionAlt_v3.pm 100644 001750 001750 1552 14645756343 25761 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t/alt-result-class-lib package DBICVersionAlt::Foo;
use base 'DBIx::Class::Core';
use strict;
use warnings;
__PACKAGE__->table('FooAlt');
__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 DBICVersionAlt::Version;
use base 'DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult';
use strict;
use warnings;
__PACKAGE__->table('dbic_version');
package DBICVersionAlt::Schema;
use base 'DBIx::Class::Schema';
use strict;
use warnings;
our $VERSION = '3.0';
__PACKAGE__->register_class('Foo', 'DBICVersionAlt::Foo');
1;
DBICVersionAlt_v1.pm 100644 001750 001750 1261 14645756343 25754 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t/alt-result-class-lib package DBICVersionAlt::Foo;
use base 'DBIx::Class::Core';
use strict;
use warnings;
__PACKAGE__->table('FooAlt');
__PACKAGE__->add_columns(
foo => {
data_type => 'INTEGER',
is_auto_increment => 1,
},
bar => {
data_type => 'VARCHAR',
size => '10'
},
);
__PACKAGE__->set_primary_key('foo');
package DBICVersionAlt::Version;
use base 'DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult';
use strict;
use warnings;
__PACKAGE__->table('dbic_version');
package DBICVersionAlt::Schema;
use base 'DBIx::Class::Schema';
use strict;
use warnings;
our $VERSION = '1.0';
__PACKAGE__->register_class('Foo', 'DBICVersionAlt::Foo');
1;
sql_translator_deprecated.t 100644 001750 001750 4230 14645756343 26770 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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
sql_translator_ignore_ddl.t 100644 001750 001750 2145 14645756343 27001 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t/deploy_methods #!perl
use strict;
use warnings;
use Test::More;
use Test::Fatal qw(dies_ok exception);
use lib 't/lib';
use DBICDHTest;
use aliased 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator';
use Path::Class qw(dir file);
use File::Temp qw(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 },
ignore_ddl => 1,
});
ok( $dm, 'DBIC::DH::DM::SQL::Translator gets instantiated correctly' );
dir($sql_dir, '_common', 'deploy', '_any')->mkpath;
open my $fh, '>',
file($sql_dir, '_common', 'deploy', qw(_any 000-bar.sql ));
print {$fh} 'INVALID SQL;';
close $fh;
like exception {
$dm->deploy;
}, qr(INVALID SQL), 'tried to run _any file when ignoring ddl';
}
done_testing;
#vim: ts=2 sw=2 expandtab
DBICVersion_v1.pm 100644 001750 001750 1060 14645756343 26130 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t/version-table-rename-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 1376 14645756343 26143 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/t/version-table-rename-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::Version;
use base 'DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult';
use strict;
use warnings;
__PACKAGE__->table('dbic_version');
package DBICVersion::Schema;
use base 'DBIx::Class::Schema';
use strict;
use warnings;
our $VERSION = '2.0';
__PACKAGE__->register_class('Foo', 'DBICVersion::Foo');
1;
LogRouter.pm 100644 001750 001750 1523 14645756343 26372 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::LogRouter;
$DBIx::Class::DeploymentHandler::LogRouter::VERSION = '0.002234';
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;
Deprecated.pm 100644 001750 001750 11226 14645756343 26531 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::Deprecated;
$DBIx::Class::DeploymentHandler::Deprecated::VERSION = '0.002234';
# ABSTRACT: (DEPRECATED) Use this if you are stuck in the past
use Moose;
use Moose::Util 'apply_all_roles';
sub initial_version { return $_[0]->database_version }
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) 2024 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 507 14645756343 26674 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::LogImporter;
$DBIx::Class::DeploymentHandler::LogImporter::VERSION = '0.002234';
use warnings;
use strict;
use parent 'Log::Contextual';
use DBIx::Class::DeploymentHandler::LogRouter;
{
my $router;
sub router { $router ||= DBIx::Class::DeploymentHandler::LogRouter->new }
}
1;
HandlesDeploy.pm 100644 001750 001750 6630 14645756343 27207 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::HandlesDeploy;
$DBIx::Class::DeploymentHandler::HandlesDeploy::VERSION = '0.002234';
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 => 2,
to_version => 1,
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) 2024 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 14645756343 25166 5 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler Intro.pod 100644 001750 001750 13336 14645756343 27153 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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) 2024 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 7432 14645756343 30077 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::HandlesVersioning;
$DBIx::Class::DeploymentHandler::HandlesVersioning::VERSION = '0.002234';
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 yield 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 yield 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 necessarily 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) 2024 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 14645756343 31311 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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 3110 14645756343 30543 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::WithApplicatorDumple;
$DBIx::Class::DeploymentHandler::WithApplicatorDumple::VERSION = '0.002234';
use MooseX::Role::Parameterized;
use Module::Runtime 'use_module';
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;
use_module($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__
HandlesVersionStorage.pm 100644 001750 001750 3603 14645756343 30722 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::HandlesVersionStorage;
$DBIx::Class::DeploymentHandler::HandlesVersionStorage::VERSION = '0.002234';
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 if the version storage is installed.
=head1 AUTHOR
Arthur Axel "fREW" Schmidt
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2024 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 14645756343 30661 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/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) 2024 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 4160 14645756343 31047 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler package DBIx::Class::DeploymentHandler::WithReasonableDefaults;
$DBIx::Class::DeploymentHandler::WithReasonableDefaults::VERSION = '0.002234';
use Moose::Role;
# ABSTRACT: Make default arguments to a few methods sensible
requires qw( prepare_upgrade prepare_downgrade initial_version schema_version );
around prepare_upgrade => sub {
my $orig = shift;
my $self = shift;
my $args = shift || {};
$args->{from_version} ||= $self->initial_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->initial_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->initial_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) 2024 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 14645756343 26723 5 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler Standard.pm 100644 001750 001750 3734 14645756343 31170 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler/VersionStorage package DBIx::Class::DeploymentHandler::VersionStorage::Standard;
$DBIx::Class::DeploymentHandler::VersionStorage::Standard::VERSION = '0.002234';
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_source => (
is => 'ro',
default => '__VERSION',
);
has version_class => (
is => 'ro',
default =>
'DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult',
);
has version_rs => (
isa => 'DBIx::Class::ResultSet',
is => 'ro',
lazy => 1,
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(
$_[0]->version_source => $_[0]->version_class )->resultset;
}
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) 2024 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 14645756343 26674 5 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler Monotonic.pm 100644 001750 001750 5601 14645756343 31341 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler/VersionHandler package DBIx::Class::DeploymentHandler::VersionHandler::Monotonic;
$DBIx::Class::DeploymentHandler::VersionHandler::Monotonic::VERSION = '0.002234';
use Moose;
use DBIx::Class::DeploymentHandler::Types;
# ABSTRACT: Obvious version progressions
use Carp 'croak';
with 'DBIx::Class::DeploymentHandler::HandlesVersioning';
has schema_version => (
isa => 'DBIx::Class::DeploymentHandler::VersionNonObj',
coerce => 1,
is => 'ro',
required => 1,
);
has initial_version => (
isa => 'Int',
is => 'ro',
required => 1,
);
has to_version => (
isa => 'DBIx::Class::DeploymentHandler::VersionNonObj',
coerce => 1,
is => 'ro',
lazy_build => 1,
);
sub _build_to_version {
my $version = $_[0]->schema_version;
ref($version) ? $version->numify : $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]->initial_version }
# provide backwards compatibility for initial_version/database_version
around BUILDARGS => sub {
my $orig = shift;
my $class = shift;
my $args = $class->$orig(@_);
$args->{initial_version} = $args->{database_version}
if exists $args->{database_version} && !exists $args->{initial_version};
return $args;
};
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->initial_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) 2024 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 5521 14645756343 31464 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler/VersionStorage package DBIx::Class::DeploymentHandler::VersionStorage::Deprecated;
$DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::VERSION = '0.002234';
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) 2024 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 14645756343 27005 5 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler/DeployMethod Translator.pm 100644 001750 001750 77662 14645756343 31676 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL package DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator;
$DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::VERSION = '0.002234';
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 Digest::MD5;
use Try::Tiny;
use SQL::SplitStatement '1.00020';
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,
);
has version_source => (
is => 'ro',
default => '__VERSION',
);
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_prep => (
isa => 'Bool',
is => 'ro',
default => 1,
);
has txn_wrap => (
is => 'ro',
isa => 'Bool',
default => 1,
);
has schema_version => (
is => 'ro',
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
}
has sql_splitter => (
is => 'ro',
lazy => 1,
builder => '_build_sql_splitter',
);
sub _build_sql_splitter { SQL::SplitStatement->new }
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_any = dir($main, $prefix, '_any');
my %files;
try {
my $dir = dir( $main, $prefix, join q(-), @{$versions} );
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 = [ $self->_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
}
my %TXN = (
SQLServer => qr/(BEGIN\s+TRANSACTION\b|COMMIT\b)/i,
Sybase => qr/(BEGIN\s+TRANSACTION\b|COMMIT\b)/i,
SQLite => qr/(BEGIN\b|COMMIT\b)/i,
mysql => qr/(BEGIN\b|START\s+TRANSACTION\b|COMMIT\b)/i,
Oracle => qr/COMMIT\b/i,
Pg => qr/(BEGIN\b|COMMIT\b)/i,
);
sub _split_sql_chunk {
my $self = shift;
my ($storage_class) = ref($self->storage) =~ /.*:(\w+)$/;
my $txn = $TXN{$storage_class} || $TXN{mysql};
# MySQL's DELIMITER is not understood by the server but handled on the client.
# SQL::SplitStatement treats the statements between the DELIMITERs correctly
# as ONE statement - but it does not remove the DELIMITER lines.
# https://rt.cpan.org/Public/Bug/Display.html?id=130473
# Transaction statements should not be present if txn_prep is false, if it
# is true then anything that looks like a transaction is removed here.
my @sql =
grep {
($storage_class ne 'mysql' || /^(?!DELIMITER\s+)/i) &&
(!$self->txn_prep || /^(?!$txn)/gim)
}
map {
$self->sql_splitter->split($_)
} @_;
for ( @sql ) {
s/\s*\n+\s*/ /g; # put on single line
}
return @sql;
}
sub _run_sql {
my ($self, $filename) = @_;
log_debug { "Running SQL from $filename" };
try {
$self->_run_sql_array($self->_read_sql_file($filename));
} catch {
die "failed to run SQL in $filename: $_"
};
}
my ( %f2p, %p2f );
sub _generate_script_package_name {
my $file = shift;
my $pkgbase = 'DBICDH::Sandbox::';
my $maxlen = 200; # actual limit is "about 250" according to perldiag
return $pkgbase . $f2p{"$file"} if $f2p{"$file"};
my $package = Digest::MD5::md5_hex("$file");
$package++ while exists $p2f{$package}; # increment until unique
die "unable to generate a unique short name for '$file'"
if length($pkgbase) + length($package) > $maxlen;
$f2p{"$file"} = $package;
$p2f{$package} = "$file";
return $pkgbase . $package;
}
sub _load_sandbox {
my $_file = shift;
$_file = "$_file";
my $_package = _generate_script_package_name($_file);
my $fn = eval sprintf <<'END_EVAL', $_package;
package %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;
try {
$fn->($self->schema, $versions)
} catch {
die "failed to run Perl in $filename: $_"
};
}
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;
my $sqltargs = $self->sql_translator_args;
if ($self->ignore_ddl) {
$sql = $self->_sql_from_yaml($sqltargs,
'_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 => 0,
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;
# SQL::Translator::Diff::schema_diff or rather the underlying
# SQL::Translator::Diff::produce_diff_sql has severe issues:
# 1. It is undocumented
# 2. It wraps the result in "BEGIN; ... COMMIT;" *SIGH*
# 3. In a first glance it seems it could also return undef in
# list context, but the code is broken enough so that part
# is never reached. *roll eyes*
my $i = 0;
my @stmts = SQL::Translator::Diff::schema_diff(
$source_schema, $db,
$dest_schema, $db,
{ sqlt_args => $sqltargs }
);
if (!$self->txn_prep && $self->txn_wrap) {
pop @stmts; # remove final COMMIT
++$i while $stmts[$i] =~ /^-- /; # skip leading comments
splice @stmts, $i, 1 if $stmts[$i] =~ /^BEGIN;/; # remove first BEGIN;
}
return \@stmts;
}
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;
binmode $file;
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 table so that it gets installed separately
parser_args => {
sources => [
sort { $a cmp $b }
grep { $_ ne $self->version_source }
$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;
binmode $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 [ $self->_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;
binmode $file;
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
A typical usage of C<_preprocess_schema> is to define indices or other non-DBIC
type metadata. Here is an example of how one might do that:
The following coderef could be placed in a file called
F<_preprocess_schema/1-2/001-add-user-index.pl>
sub {
my ($from, $to) = @_;
$to->get_table('Users')->add_index(
name => 'idx_Users_name',
fields => ['name'],
)
}
This would ensure that in version 2 of the schema the generated migrations
include an index on C<< Users.name >>. Frustratingly, due to the nature of
L, you'll need to add this to each migration or it will detect
that it was left out and kindly remove the index for you.
An alternative to the above, which is likely to be a lot less annoying, is to
define such data in your schema directly, and only change it as you need to:
package MyApp::Schema::Result::User;
#[...]
sub sqlt_deploy_hook ( $self, $sqlt_table ) {
$sqlt_table->add_index(name => 'idx_Users_name', fields => [ 'name' ]);
}
=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
If you are using the C functionality,
you should call initialize() before calling C. This 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_prep
This attribute will, when set to false (default is true), cause the DM to
I SQL without enclosing C and C statements.
The (current) default behavior is to create DDLs wrapped in transactions and
to remove anything that looks like a transaction from the generated DDLs
later I.
Since this default behavior is error prone it is strictly recommended to set
the C attribute to false and remove all transaction statements from
previously generated DDLs.
=head2 txn_wrap
Set to true (which is the default) to wrap all upgrades and deploys in a single
transaction. This option should be false if the DDL files contain transaction
statements.
Keep in mind that not all DBMSes support transactions over DDL statements.
=head2 schema_version
The version the schema on your harddrive is at. Defaults to
C<< $self->schema->schema_version >>.
=head2 version_source
The source name used to register the version storage with C. Defaults
to C<__VERSION>.
=head1 AUTHOR
Arthur Axel "fREW" Schmidt
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2024 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 6621 14645756343 32711 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler/VersionHandler package DBIx::Class::DeploymentHandler::VersionHandler::ExplicitVersions;
$DBIx::Class::DeploymentHandler::VersionHandler::ExplicitVersions::VERSION = '0.002234';
use Moose;
# ABSTRACT: Define your own list of versions to use for migrations
use Carp 'croak';
with 'DBIx::Class::DeploymentHandler::HandlesVersioning';
has schema_version => (
is => 'ro',
required => 1,
);
has initial_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]->initial_version} }
sub _inc_version_idx { $_[0]->_version_idx($_[0]->_version_idx + 1 ) }
sub _dec_version_idx { $_[0]->_version_idx($_[0]->_version_idx - 1 ) }
# provide backwards compatibility for initial_version/database_version
around BUILDARGS => sub {
my $orig = shift;
my $class = shift;
my $args = $class->$orig(@_);
$args->{initial_version} = $args->{database_version}
if exists $args->{database_version} && !exists $args->{initial_version};
return $args;
};
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) 2024 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 14645756343 30463 5 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler/VersionStorage Component.pm 100644 001750 001750 3326 14645756343 33127 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard package DBIx::Class::DeploymentHandler::VersionStorage::Standard::Component;
$DBIx::Class::DeploymentHandler::VersionStorage::Standard::Component::VERSION = '0.002234';
# 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) 2024 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 14645756343 30763 5 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler/VersionStorage Component.pm 100644 001750 001750 4013 14645756343 33421 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated package DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::Component;
$DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::Component::VERSION = '0.002234';
# 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) 2024 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 3420 14645756343 34004 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard package DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult;
$DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResult::VERSION = '0.002234';
# ABSTRACT: The typical way to store versions in the database
use strict;
use warnings;
use parent 'DBIx::Class::Core';
my $table = 'dbix_class_deploymenthandler_versions';
__PACKAGE__->table($table);
__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');
sub sqlt_deploy_hook {
my ( $self, $sqlt_table ) = @_;
my $tname = $sqlt_table->name;
return if $tname eq $table;
# give indices unique names for sub-classes on different tables
foreach my $c ( $sqlt_table->get_constraints ) {
( my $cname = $c->name ) =~ s/\Q$table\E/$tname/;
$c->name($cname);
}
}
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) 2024 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 14645756343 31136 5 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL Deprecated.pm 100644 001750 001750 6527 14645756343 33706 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator package DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::Deprecated;
$DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::Deprecated::VERSION = '0.002234';
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) 2024 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 3040 14645756343 34302 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated package DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::VersionResult;
$DBIx::Class::DeploymentHandler::VersionStorage::Deprecated::VersionResult::VERSION = '0.002234';
# 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) 2024 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 4171 14645756343 34256 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler/VersionHandler package DBIx::Class::DeploymentHandler::VersionHandler::DatabaseToSchemaVersions;
$DBIx::Class::DeploymentHandler::VersionHandler::DatabaseToSchemaVersions::VERSION = '0.002234';
use Moose;
# ABSTRACT: Go straight from Database to Schema version
with 'DBIx::Class::DeploymentHandler::HandlesVersioning';
has schema_version => (
is => 'ro',
required => 1,
);
has initial_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,
);
# provide backwards compatibility for initial_version/database_version
around BUILDARGS => sub {
my $orig = shift;
my $class = shift;
my $args = $class->$orig(@_);
$args->{initial_version} = $args->{database_version}
if exists $args->{database_version} && !exists $args->{initial_version};
return $args;
};
sub next_version_set {
my $self = shift;
return undef
if $self->once;
$self->once(!$self->once);
return undef
if $self->initial_version eq $self->to_version;
return [$self->initial_version, $self->to_version];
}
sub previous_version_set {
my $self = shift;
return undef
if $self->once;
$self->once(!$self->once);
return undef
if $self->initial_version eq $self->to_version;
return [$self->initial_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) 2024 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 2367 14645756343 34471 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard package DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResultSet;
$DBIx::Class::DeploymentHandler::VersionStorage::Standard::VersionResultSet::VERSION = '0.002234';
# 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) 2024 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 13656 14645756343 34456 0 ustar 00wes wes 000000 000000 DBIx-Class-DeploymentHandler-0.002234/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator package DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::ScriptHelpers;
$DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::ScriptHelpers::VERSION = '0.002234';
# ABSTRACT: CodeRef Transforms for common use-cases in DBICDH Migrations
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 - CodeRef Transforms for common use-cases in DBICDH Migrations
=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 CUSTOM SCRIPT HELPERS
If you find that in your scripts you need to always pass the same arguments to
your script helpers, you may want to define a custom set of script helpers. I
am not sure that there is a better way than just using Perl and other modules
that are already installed when you install L.
The following is a pattern that will get you started; if anyone has ideas on
how to make this even easier let me know.
package MyApp::DBICDH::ScriptHelpers;
use strict;
use warnings;
use DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::ScriptHelpers
dbh => { -as => '_old_dbh' },
schema_from_schema_loader => { -as => '_old_sfsl' };
use Sub::Exporter::Progressive -setup => {
exports => [qw(dbh schema_from_schema_loader)],
};
sub dbh {
my $coderef = shift;
_old_dbh(sub {
my ($dbh) = @_;
$dbh->do(q(SET search_path TO 'myapp_db'));
$coderef->(@_);
});
}
sub schema_from_schema_loader {
my ($config, $coderef) = @_;
$config->{naming} ||= 'v7';
_old_sfsl(sub {
my ($schema) = @_;
$schema->storage->dbh->do(q(SET search_path TO 'myapp_db'));
$coderef->(@_);
});
}
The above will default the naming to C when using
C