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 /);
  18
  19 die "You need to specify one DDL output filename via --ddl-out\n"
  20   if @{$args->{'ddl-out'}||[]} != 1;
  21
  22 die "You need to specify one DBIC schema class via --schema-class\n"
  23   if @{$args->{'schema-class'}||[]} != 1;
  24
  25
  26 my $schema = use_module( $args->{'schema-class'}[0] )->connect();
  27
  28 my $ddl_fh;
  29 if ($args->{'ddl-out'}[0] eq '-') {
  30   $ddl_fh = *STDOUT;
  31 }
  32 else {
  33   my $fn = file($args->{'ddl-out'}[0]);
  34   $fn->dir->mkpath;
  35   open $ddl_fh, '>', $fn
  36     or die "Unable to open $fn: $!\n";
  37 }
  38 binmode $ddl_fh;  # avoid win32 \n crapfest
  39
  40 print $ddl_fh scalar $schema->deployment_statements(
  41   'SQLite',
  42   undef,
  43   undef,
  44   {
  45     producer_args => { no_transaction => 1 },
  46     quote_identifiers => 1,
  47     no_comments => 1,
  48   },
  49 );