#!/usr/bin/env perl
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
;
print
$ddl_fh
scalar
$schema
->deployment_statements(
'SQLite'
,
undef
,
undef
,
{
producer_args
=> {
no_transaction
=> 1 },
quote_identifiers
=> 1,
no_comments
=> 1,
},
);