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 SQL::Translator;
   8 use Path::Class 'file';
   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   file($args->{'deploy-to'}[0])->dir->mkpath;
  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   my $fn = file($args->{'ddl-out'}[0]);
  47   $fn->dir->mkpath;
  48   open $ddl_fh, '>', $fn
  49     or die "Unable to open $fn: $!\n";
  50 }
  51 binmode $ddl_fh;  # avoid win32 \n crapfest
  52
  53 print $ddl_fh scalar $schema->deployment_statements(
  54   'SQLite',
  55   undef,
  56   undef,
  57   {
  58     producer_args => { no_transaction => 1 },
  59     quote_identifiers => 1,
  60     no_comments => 1,
  61   },
  62 );