From: Peter Rabbitson <ribasushi@cpan.org>
Date: Mon, 26 Aug 2013 11:05:52 +0000 (+0200)
Subject: Generalize the SQLite DDL generation tool (see next commit)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a2c296335a7a7190f412ed7470619189bb30766f;p=dbsrgits%2FDBIx-Class-Historic.git

Generalize the SQLite DDL generation tool (see next commit)
---

diff --git a/maint/Makefile.PL.inc/56_autogen_schema_files.pl b/maint/Makefile.PL.inc/56_autogen_schema_files.pl
new file mode 100644
index 0000000..446cc2a
--- /dev/null
+++ b/maint/Makefile.PL.inc/56_autogen_schema_files.pl
@@ -0,0 +1,27 @@
+require File::Spec;
+my $test_ddl_fn = File::Spec->catfile(qw( t lib sqlite.sql ));
+my @test_ddl_cmd = qw( -I lib -I t/lib -- maint/gen_sqlite_schema_files --schema-class DBICTest::Schema );
+
+# If the author doesn't have the prereqs, still generate a Makefile
+# The EUMM build-stage generation will run unconditionally and
+# errors will not be ignored unlike here
+require DBIx::Class::Optional::Dependencies;
+if ( DBIx::Class::Optional::Dependencies->req_ok_for ('deploy') ) {
+  print "Regenerating $test_ddl_fn\n";
+  system( $^X, @test_ddl_cmd, '--ddl-out' => $test_ddl_fn );
+
+  # if we don't do it some git tools (e.g. gitk) get confused that the
+  # ddl file is modified, when it clearly isn't
+  system('git status --porcelain >' . File::Spec->devnull);
+}
+
+postamble <<"EOP";
+
+clonedir_generate_files : dbic_clonedir_regen_test_ddl
+
+dbic_clonedir_regen_test_ddl :
+\t\$(ABSPERLRUN) @test_ddl_cmd --ddl-out @{[ $mm_proto->quote_literal($test_ddl_fn) ]}
+EOP
+
+# keep the Makefile.PL eval happy
+1;
diff --git a/maint/Makefile.PL.inc/56_autogen_testddl.pl b/maint/Makefile.PL.inc/56_autogen_testddl.pl
deleted file mode 100644
index a9425d3..0000000
--- a/maint/Makefile.PL.inc/56_autogen_testddl.pl
+++ /dev/null
@@ -1,33 +0,0 @@
-require File::Spec;
-my $ddl_fn = File::Spec->catfile(qw(t lib sqlite.sql));
-
-# If the author doesn't have the prereqs, we will end up obliterating
-# the ddl file, and all tests will fail, therefore don't do anything
-# on error
-# The EUMM build-stage generation will run unconditionally and
-# errors will not be trapped
-require DBIx::Class::Optional::Dependencies;
-if ( DBIx::Class::Optional::Dependencies->req_ok_for ('deploy') ) {
-  print "Regenerating t/lib/sqlite.sql\n";
-  if (my $out = ` "$^X" -Ilib maint/gen_schema `) {
-    open (my $fh, '>:unix', $ddl_fn) or die "Unable to open $ddl_fn: $!";
-    print $fh $out;
-    close $fh;
-
-    # if we don't do it some git tools (e.g. gitk) get confused that the
-    # ddl file is modified, when it clearly isn't
-    system('git status --porcelain >' . File::Spec->devnull);
-  }
-}
-
-postamble <<"EOP";
-
-clonedir_generate_files : dbic_clonedir_regen_test_ddl
-
-dbic_clonedir_regen_test_ddl :
-\t\$(ABSPERLRUN) -Ilib -- maint/gen_schema > @{[ $mm_proto->quote_literal($ddl_fn) ]}
-@{[ $crlf_fixup->($ddl_fn) ]}
-EOP
-
-# keep the Makefile.PL eval happy
-1;
diff --git a/maint/gen_schema b/maint/gen_schema
deleted file mode 100755
index 9fe1030..0000000
--- a/maint/gen_schema
+++ /dev/null
@@ -1,21 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-use lib qw(lib t/lib);
-
-use DBICTest::Schema;
-use SQL::Translator;
-
-my $schema = DBICTest::Schema->connect;
-print scalar ($schema->storage->deployment_statements(
-  $schema,
-  'SQLite',
-  undef,
-  undef,
-  {
-    producer_args => { no_transaction => 1 },
-    quote_identifiers => 1,
-    no_comments => 1,
-  },
-));
diff --git a/maint/gen_sqlite_schema_files b/maint/gen_sqlite_schema_files
new file mode 100755
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,
+  },
+);
diff --git a/t/lib/DBICTest/Schema.pm b/t/lib/DBICTest/Schema.pm
index 8abb593..b77c0d7 100644
--- a/t/lib/DBICTest/Schema.pm
+++ b/t/lib/DBICTest/Schema.pm
@@ -150,14 +150,9 @@ sub connection {
     # Also if there is no connection - there is no lock to be had
     if ($locktype and (!$locker or $locker->{type} ne $locktype)) {
 
-      warn "$$ $0 $locktype" if (
-        ($locktype eq 'generic' or $locktype eq 'SQLite')
-          and
-        DBICTest::RunMode->is_author
-      );
-
       my $lockpath = DBICTest::RunMode->tmpdir->file(".dbictest_$locktype.lock");
 
+      #warn "$$ $0 $locktype GRABBING LOCK";
       my $lock_fh;
       {
         my $u = local_umask(0); # so that the file opens as 666, and any user can lock