Commit | Line | Data |
3467d1a5 |
1 | package DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::ScriptHelpers; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Sub::Exporter -setup => { |
7 | exports => [qw(dbh schema_from_schema_loader)], |
8 | }; |
9 | |
10 | use List::Util 'first'; |
11 | |
12 | sub dbh { |
13 | my ($code) = @_; |
14 | sub { |
15 | my ($schema, $versions) = @_; |
16 | $schema->storage->dbh_do(sub { |
17 | $code->($_[1], $versions) |
18 | }) |
19 | } |
20 | } |
21 | |
22 | sub _rearrange_connect_info { |
23 | my ($storage) = @_; |
24 | |
25 | my $nci = $storage->_normalize_connect_info($storage->connect_info); |
26 | |
27 | return { |
28 | dbh_maker => sub { $storage->dbh }, |
29 | map %{$nci->{$_}}, grep { $_ ne 'arguments' } keys %$nci, |
30 | }; |
31 | } |
32 | |
33 | my $count = 0; |
34 | sub schema_from_schema_loader { |
35 | my ($opts, $code) = @_; |
36 | |
37 | die 'schema_from_schema_loader requires options!' |
38 | unless $opts && ref $opts && ref $opts eq 'HASH'; |
39 | |
40 | die 'schema_from_schema_loader requires naming settings to be set!' |
41 | unless $opts->{naming}; |
42 | |
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}}); |
46 | sub { |
47 | my ($schema, $versions) = @_; |
48 | |
49 | require DBIx::Class::Schema::Loader; |
50 | |
51 | $schema->storage->ensure_connected; |
52 | my @ci = _rearrange_connect_info($schema->storage); |
53 | |
54 | my $new_schema = DBIx::Class::Schema::Loader::make_schema_at( |
55 | 'SHSchema::' . $count++, $opts, \@ci |
56 | ); |
57 | my $sl_schema = $new_schema->connect(@ci); |
58 | $code->($sl_schema, $versions) |
59 | } |
60 | } |
61 | |
62 | 1; |
63 | |
64 | __END__ |
65 | |
66 | =head1 SYNOPSIS |
67 | |
68 | use DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::ScriptHelpers |
69 | 'schema_from_schema_loader'; |
70 | |
71 | schema_from_schema_loader({ naming => 'v4' }, sub { |
72 | my ($schema, $version_set) = @_; |
73 | |
74 | ... |
75 | }); |
76 | |
77 | =head1 DESCRIPTION |
78 | |
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 |
83 | prefer. |
84 | |
85 | =head1 EXPORTED SUBROUTINES |
86 | |
87 | =head2 dbh($coderef) |
88 | |
89 | dbh(sub { |
90 | my ($dbh, $version_set) = @_; |
91 | |
92 | ... |
93 | }); |
94 | |
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. |
97 | |
98 | =head2 schema_from_schema_loader($sl_opts, $coderef) |
99 | |
100 | schema_from_schema_loader({ naming => 'v4' }, sub { |
101 | my ($schema, $version_set) = @_; |
102 | |
103 | ... |
104 | }); |
105 | |
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 |
109 | script. |
110 | |
111 | Note that C<$sl_opts> requires that you specify something for the C<naming> |
112 | option. |