1 package DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::ScriptHelpers;
6 use Sub::Exporter::Progressive -setup => {
7 exports => [qw(dbh schema_from_schema_loader)],
10 use List::Util 'first';
11 use Text::Brew 'distance';
13 use DBIx::Class::DeploymentHandler::LogImporter qw(:dlog);
18 my ($schema, $versions) = @_;
19 $schema->storage->dbh_do(sub {
20 $code->($_[1], $versions)
25 sub _rearrange_connect_info {
28 my $nci = $storage->_normalize_connect_info($storage->connect_info);
31 dbh_maker => sub { $storage->dbh },
32 map %{$nci->{$_}}, grep { $_ ne 'arguments' } keys %$nci,
37 sub schema_from_schema_loader {
38 my ($opts, $code) = @_;
40 die 'schema_from_schema_loader requires options!'
41 unless $opts && ref $opts && ref $opts eq 'HASH';
43 die 'schema_from_schema_loader requires naming settings to be set!'
44 unless $opts->{naming};
46 warn 'using "current" naming in a deployment script is begging for problems. Just Say No.'
47 if $opts->{naming} eq 'current' ||
48 (ref $opts->{naming} eq 'HASH' && first { $_ eq 'current' } values %{$opts->{naming}});
51 if !exists $opts->{debug} && $ENV{DBICDH_TRACE};
54 my ($schema, $versions) = @_;
56 require DBIx::Class::Schema::Loader;
58 $schema->storage->ensure_connected;
59 my @ci = _rearrange_connect_info($schema->storage);
61 my $new_schema = DBIx::Class::Schema::Loader::make_schema_at(
62 'SHSchema::' . $count++, $opts, \@ci
66 "schema_from_schema_loader generated the following sources: $_"
67 } [ $new_schema->sources ];
68 my $sl_schema = $new_schema->connect(@ci);
70 $code->($sl_schema, $versions)
72 if (m/Can't find source for (.+?) at/) {
73 my @presentsources = map {
74 (distance($_, $1))[0] < 3 ? "$_ <== Possible Match\n" : "$_\n";
75 } $sl_schema->sources;
79 You are seeing this error because the DBIx::Class::ResultSource in your
80 migration script called "$1" is not part of the schema that ::Schema::Loader
81 has inferred from your existing database.
83 To help you debug this issue, here's a list of the actual sources that the
84 schema available to your migration knows about:
100 use DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::ScriptHelpers
101 'schema_from_schema_loader';
103 schema_from_schema_loader({ naming => 'v4' }, sub {
104 my ($schema, $version_set) = @_;
111 This package is a set of coderef transforms for common use-cases in migrations.
112 The subroutines are simply helpers for creating coderefs that will work for
113 L<DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator/PERL SCRIPTS>,
114 yet have some argument other than the current schema that you as a user might
117 =head1 EXPORTED SUBROUTINES
122 my ($dbh, $version_set) = @_;
127 For those times when you almost exclusively need access to "the bare metal".
128 Simply gives you the correct database handle and the expected version set.
130 =head2 schema_from_schema_loader($sl_opts, $coderef)
132 schema_from_schema_loader({ naming => 'v4' }, sub {
133 my ($schema, $version_set) = @_;
138 Any time you write a perl migration script that uses a L<DBIx::Class::Schema>
139 you should probably use this. Otherwise you'll run into problems if you remove
140 a column from your schema yet still populate to it in an older population
143 Note that C<$sl_opts> requires that you specify something for the C<naming>