1 package DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::ScriptHelpers;
3 # ABSTRACT: CodeRef Transforms for common use-cases in DBICDH Migrations
8 use Sub::Exporter::Progressive -setup => {
9 exports => [qw(dbh schema_from_schema_loader)],
12 use List::Util 'first';
13 use Text::Brew 'distance';
15 use DBIx::Class::DeploymentHandler::LogImporter qw(:dlog);
20 my ($schema, $versions) = @_;
21 $schema->storage->dbh_do(sub {
22 $code->($_[1], $versions)
27 sub _rearrange_connect_info {
30 my $nci = $storage->_normalize_connect_info($storage->connect_info);
33 dbh_maker => sub { $storage->dbh },
34 map %{$nci->{$_}}, grep { $_ ne 'arguments' } keys %$nci,
39 sub schema_from_schema_loader {
40 my ($opts, $code) = @_;
42 die 'schema_from_schema_loader requires options!'
43 unless $opts && ref $opts && ref $opts eq 'HASH';
45 die 'schema_from_schema_loader requires naming settings to be set!'
46 unless $opts->{naming};
48 warn 'using "current" naming in a deployment script is begging for problems. Just Say No.'
49 if $opts->{naming} eq 'current' ||
50 (ref $opts->{naming} eq 'HASH' && first { $_ eq 'current' } values %{$opts->{naming}});
53 if !exists $opts->{debug} && $ENV{DBICDH_TRACE};
56 my ($schema, $versions) = @_;
58 require DBIx::Class::Schema::Loader;
60 $schema->storage->ensure_connected;
61 my @ci = _rearrange_connect_info($schema->storage);
63 my $new_schema = DBIx::Class::Schema::Loader::make_schema_at(
64 'SHSchema::' . $count++, $opts, \@ci
68 "schema_from_schema_loader generated the following sources: $_"
69 } [ $new_schema->sources ];
70 my $sl_schema = $new_schema->connect(@ci);
72 $code->($sl_schema, $versions)
74 if (m/Can't find source for (.+?) at/) {
75 my @presentsources = map {
76 (distance($_, $1))[0] < 3 ? "$_ <== Possible Match\n" : "$_\n";
77 } $sl_schema->sources;
81 You are seeing this error because the DBIx::Class::ResultSource in your
82 migration script called "$1" is not part of the schema that ::Schema::Loader
83 has inferred from your existing database.
85 To help you debug this issue, here's a list of the actual sources that the
86 schema available to your migration knows about:
102 use DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::ScriptHelpers
103 'schema_from_schema_loader';
105 schema_from_schema_loader({ naming => 'v4' }, sub {
106 my ($schema, $version_set) = @_;
113 This package is a set of coderef transforms for common use-cases in migrations.
114 The subroutines are simply helpers for creating coderefs that will work for
115 L<DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator/PERL SCRIPTS>,
116 yet have some argument other than the current schema that you as a user might
119 =head1 EXPORTED SUBROUTINES
124 my ($dbh, $version_set) = @_;
129 For those times when you almost exclusively need access to "the bare metal".
130 Simply gives you the correct database handle and the expected version set.
132 =head2 schema_from_schema_loader($sl_opts, $coderef)
134 schema_from_schema_loader({ naming => 'v4' }, sub {
135 my ($schema, $version_set) = @_;
140 Any time you write a perl migration script that uses a L<DBIx::Class::Schema>
141 you should probably use this. Otherwise you'll run into problems if you remove
142 a column from your schema yet still populate to it in an older population
145 Note that C<$sl_opts> requires that you specify something for the C<naming>