1 package DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::ScriptHelpers;
6 use Sub::Exporter -setup => {
7 exports => [qw(dbh schema_from_schema_loader)],
10 use List::Util 'first';
15 my ($schema, $versions) = @_;
16 $schema->storage->dbh_do(sub {
17 $code->($_[1], $versions)
22 sub _rearrange_connect_info {
25 my $nci = $storage->_normalize_connect_info($storage->connect_info);
28 dbh_maker => sub { $storage->dbh },
29 map %{$nci->{$_}}, grep { $_ ne 'arguments' } keys %$nci,
34 sub schema_from_schema_loader {
35 my ($opts, $code) = @_;
37 die 'schema_from_schema_loader requires options!'
38 unless $opts && ref $opts && ref $opts eq 'HASH';
40 die 'schema_from_schema_loader requires naming settings to be set!'
41 unless $opts->{naming};
43 warn 'using "current" naming in a deployment script is begging for problems. Just Say No.'
44 if $opts->{naming} eq 'current' ||
45 (ref $opts->{naming} eq 'HASH' && first { $_ eq 'current' } values %{$opts->{naming}});
47 my ($schema, $versions) = @_;
49 require DBIx::Class::Schema::Loader;
51 $schema->storage->ensure_connected;
52 my @ci = _rearrange_connect_info($schema->storage);
54 my $new_schema = DBIx::Class::Schema::Loader::make_schema_at(
55 'SHSchema::' . $count++, $opts, \@ci
57 my $sl_schema = $new_schema->connect(@ci);
58 $code->($sl_schema, $versions)
68 use DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::ScriptHelpers
69 'schema_from_schema_loader';
71 schema_from_schema_loader({ naming => 'v4' }, sub {
72 my ($schema, $version_set) = @_;
79 This package is a set of coderef transforms for common use-cases in migrations.
80 The subroutines are simply helpers for creating coderefs that will work for
81 L<DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator/PERL SCRIPTS>,
82 yet have some argument other than the current schema that you as a user might
85 =head1 EXPORTED SUBROUTINES
90 my ($dbh, $version_set) = @_;
95 For those times when you almost exclusively need access to "the bare metal".
96 Simply gives you the correct database handle and the expected version set.
98 =head2 schema_from_schema_loader($sl_opts, $coderef)
100 schema_from_schema_loader({ naming => 'v4' }, sub {
101 my ($schema, $version_set) = @_;
106 Any time you write a perl migration script that uses a L<DBIx::Class::Schema>
107 you should probably use this. Otherwise you'll run into problems if you remove
108 a column from your schema yet still populate to it in an older population
111 Note that C<$sl_opts> requires that you specify something for the C<naming>