maint/gen_sqlite_schema_files

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