Rewrite sql formatter script and shove it into examples until more tested

Combined with the opportunistic parser this little tool has the promise of
actually being useful outside of the echo chamber. Someone with good UX
skillz ought to take this to the next level... or something ;)

diff --git a/Changes b/Changes
index e0bbbce..03eebf7 100644 (file)
--- a/Changes
+++ b/Changes
@@ -4,6 +4,8 @@ Revision history for SQL::Abstract
       element, instead of gobbling up the entire parse-to-date
     - Explicitly handle ROW_NUMBER() OVER as the snowflake-operator it is
     - Improve signatures/documentation of is_same_sql_bind / eq_sql_bind
+    - Retire script/format-sql - the utility needs more work to be truly
+      end-user convenient
 
 revision 1.77  2014-01-17
 ----------------------------

diff --git a/Makefile.PL b/Makefile.PL
index 03135ac..8faa856 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -19,7 +19,6 @@ requires 'List::Util'   => 0;
 requires 'Scalar::Util' => 0;
 requires 'Moo'          => 1.004002;
 requires 'Hash::Merge'  => 0.12;
-requires 'Getopt::Long::Descriptive' => 0.091;
 
 test_requires "Test::More"      => 0.88;
 test_requires "Test::Exception" => 0.31;
@@ -30,8 +29,6 @@ test_requires "Storable"        => 0;   # for cloning in tests
 no_index package => 'DBIx::Class::Storage::Debug::PrettyPrint';
 no_index directory => 'examples';
 
-install_script 'format-sql';
-
 tests_recursive 't';
 
 auto_install();

diff --git a/examples/console.pl b/examples/console.pl
index 277c5c2..abb4386 100644 (file)
--- a/examples/console.pl
+++ b/examples/console.pl
@@ -1,5 +1,8 @@
 #!/sur/bin/env perl
 
+use warnings;
+use strict;
+
 use SQL::Abstract::Tree;
 
 my $sqlat = SQL::Abstract::Tree->new({ profile => 'console' });

diff --git a/examples/dbic-console.pl b/examples/dbic-console.pl
index c4bb624..5054424 100644 (file)
--- a/examples/dbic-console.pl
+++ b/examples/dbic-console.pl
@@ -1,5 +1,8 @@
 #!/sur/bin/env perl
 
+use warnings;
+use strict;
+
 use DBIx::Class::Storage::Debug::PrettyPrint;
 
 my $pp = DBIx::Class::Storage::Debug::PrettyPrint->new({

diff --git a/examples/sqla-format b/examples/sqla-format
new file mode 100755 (executable)
index 0000000..0041b6c
--- /dev/null
+++ b/examples/sqla-format
@@ -0,0 +1,61 @@
+#!/usr/bin/env perl
+
+use warnings;
+use strict;
+
+use Getopt::Long;
+my $p = Getopt::Long::Parser->new(config => [qw( gnu_getopt no_ignore_case )]);
+my $opts = { profile => 'console', help => \&showhelp };
+$p->getoptions( $opts, qw(
+  profile|p=s
+  help|h
+)) or showhelp();
+
+sub showhelp {
+  require Pod::Usage;
+  Pod::Usage::pod2usage( -verbose => 0, -exitval => 2 );
+}
+
+require SQL::Abstract::Tree;
+my $sqlat = SQL::Abstract::Tree->new({ profile => $opts->{profile}, fill_in_placeholders => 0 });
+
+my $chunk = '';
+my $leftover = '';
+do {
+  $chunk = $leftover . $chunk if length $leftover;
+
+  if ($chunk =~ / \A (.+?) (?:
+    (?<=\S)\:\s+\'[^\n]+  # pasting DBIC_TRACE output directly
+      |
+    \;(?: \s | \z)
+      |
+    \z
+      |
+    ^ \s* (?=SELECT|INSERT|UPDATE|DELETE)
+  ) (.*) /smix) {
+
+    $leftover = $2;
+    print $sqlat->format($1);
+    print "\n";
+  }
+  else {
+    $leftover = $chunk;
+  }
+} while ( (read *STDIN, $chunk, 4096) or length $leftover );
+
+=head1 NAME
+
+sqla-format - An intelligent SQL formatter
+
+=head1 SYNOPSIS
+
+ ~$ sqla-format << log.sql
+
+ ~$ myprogram -v | sqla-format -p html > sqltrace.html
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.

diff --git a/script/format-sql b/script/format-sql
deleted file mode 100755 (executable)
index 06bd65e..0000000
--- a/script/format-sql
+++ /dev/null
@@ -1,16 +0,0 @@
-#!/usr/bin/env perl
-
-use SQL::Abstract::Tree;
-use Getopt::Long::Descriptive;
-
-my ($opt, $usage) = describe_options(
-  'format-sql %o',
-  [ 'profile|p=s',   "the profile to use", { default => 'console' } ],
-  [ 'help',       "print usage message and exit" ],
-);
-
-  print($usage->text), exit if $opt->help;
-
-my $sqlat = SQL::Abstract::Tree->new({ profile => $opt->profile, fill_in_placeholders => 0 });
-
-print $sqlat->format($_) . "\n" while <>;