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';
17 my ($schema, $versions) = @_;
18 $schema->storage->dbh_do(sub {
19 $code->($_[1], $versions)
24 sub _rearrange_connect_info {
27 my $nci = $storage->_normalize_connect_info($storage->connect_info);
30 dbh_maker => sub { $storage->dbh },
31 map %{$nci->{$_}}, grep { $_ ne 'arguments' } keys %$nci,
36 sub schema_from_schema_loader {
37 my ($opts, $code) = @_;
39 die 'schema_from_schema_loader requires options!'
40 unless $opts && ref $opts && ref $opts eq 'HASH';
42 die 'schema_from_schema_loader requires naming settings to be set!'
43 unless $opts->{naming};
45 warn 'using "current" naming in a deployment script is begging for problems. Just Say No.'
46 if $opts->{naming} eq 'current' ||
47 (ref $opts->{naming} eq 'HASH' && first { $_ eq 'current' } values %{$opts->{naming}});
50 my ($schema, $versions) = @_;
52 require DBIx::Class::Schema::Loader;
54 $schema->storage->ensure_connected;
55 my @ci = _rearrange_connect_info($schema->storage);
57 my $new_schema = DBIx::Class::Schema::Loader::make_schema_at(
58 'SHSchema::' . $count++, $opts, \@ci
60 my $sl_schema = $new_schema->connect(@ci);
62 $code->($sl_schema, $versions)
64 if (m/Can't find source for (.+?) at/) {
65 my @presentsources = map {
66 (distance($_, $1))[0] < 3 ? "$_ <== Possible Match\n" : "$_\n";
67 } $sl_schema->sources;
71 You are seeing this error because the DBIx::Class::ResultSource in your
72 migration script called "$1" is not part of the schema that ::Schema::Loader
73 has inferred from your existing database.
75 To help you debug this issue, here's a list of the actual sources that the
76 schema available to your migration knows about:
92 use DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::ScriptHelpers
93 'schema_from_schema_loader';
95 schema_from_schema_loader({ naming => 'v4' }, sub {
96 my ($schema, $version_set) = @_;
103 This package is a set of coderef transforms for common use-cases in migrations.
104 The subroutines are simply helpers for creating coderefs that will work for
105 L<DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator/PERL SCRIPTS>,
106 yet have some argument other than the current schema that you as a user might
109 =head1 EXPORTED SUBROUTINES
114 my ($dbh, $version_set) = @_;
119 For those times when you almost exclusively need access to "the bare metal".
120 Simply gives you the correct database handle and the expected version set.
122 =head2 schema_from_schema_loader($sl_opts, $coderef)
124 schema_from_schema_loader({ naming => 'v4' }, sub {
125 my ($schema, $version_set) = @_;
130 Any time you write a perl migration script that uses a L<DBIx::Class::Schema>
131 you should probably use this. Otherwise you'll run into problems if you remove
132 a column from your schema yet still populate to it in an older population
135 Note that C<$sl_opts> requires that you specify something for the C<naming>