Generalize the SQLite DDL generation tool (see next commit)

[dbsrgits/DBIx-Class.git] / maint / gen_sqlite_schema_files

diff --git a/maint/gen_sqlite_schema_files b/maint/gen_sqlite_schema_files
new file mode 100755 (executable)
index 0000000..9fa6a4c
--- /dev/null
+++ b/maint/gen_sqlite_schema_files
@@ -0,0 +1,49 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Module::Runtime 'use_module';
+use SQL::Translator;
+use Path::Class 'file';
+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@
+/);
+
+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;
+
+
+my $schema = use_module( $args->{'schema-class'}[0] )->connect();
+
+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;  # 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,
+  },
+);