1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
#!/usr/bin/env perl
use strict;
use warnings;
use SQL::Translator;
use Path::Class 'file';
use Getopt::Long;
my $getopt = Getopt::Long::Parser->new(
config => [qw/gnu_getopt bundling_override no_ignore_case/]
);
my $args = {};
$getopt->getoptions($args, qw/
ddl-out=s@
schema-class=s@
deploy-to=s@
/);
die "You need to specify one DDL output filename via --ddl-out\n"
if @{$args->{'ddl-out'}||[]} != 1;
die "You need to specify one DBIC schema class via --schema-class\n"
if @{$args->{'schema-class'}||[]} != 1;
die "You may not specify more than one deploy path via --deploy-to\n"
if @{$args->{'deploy-to'}||[]} > 1;
local $ENV{DBI_DSN};
eval "require $args->{'schema-class'}[0]" || die $@;
my $schema = $args->{'schema-class'}[0]->connect(
$args->{'deploy-to'}
? ( "DBI:SQLite:$args->{'deploy-to'}[0]", undef, undef, { on_connect_do => "PRAGMA synchronous = OFF" } )
: ()
);
if ($args->{'deploy-to'}) {
file($args->{'deploy-to'}[0])->dir->mkpath;
$schema->deploy({ add_drop_table => 1 });
}
my $ddl_fh;
if ($args->{'ddl-out'}[0] eq '-') {
$ddl_fh = *STDOUT;
}
else {
my $fn = file($args->{'ddl-out'}[0]);
$fn->dir->mkpath;
open $ddl_fh, '>', $fn
or die "Unable to open $fn: $!\n";
}
binmode $ddl_fh; # avoid win32 \n crapfest
print $ddl_fh scalar $schema->deployment_statements(
'SQLite',
undef,
undef,
{
producer_args => { no_transaction => 1 },
quote_identifiers => 1,
no_comments => 1,
},
);
|
