#!/usr/bin/env perl use strict; use warnings; use Module::Runtime 'use_module'; use DBIx::Class::_Util qw(mkdir_p parent_dir); use SQL::Translator; 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}; my $schema = use_module( $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'}) { mkdir_p parent_dir $args->{'deploy-to'}[0]; $schema->deploy({ add_drop_table => 1 }); } my $ddl_fh; if ($args->{'ddl-out'}[0] eq '-') { $ddl_fh = *STDOUT; } else { mkdir_p parent_dir $args->{'ddl-out'}[0]; open $ddl_fh, '>', $args->{'ddl-out'}[0] or die "Unable to open $args->{'ddl-out'}[0]: $!\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, }, );