remove obsolete thing that never worked
[scpubgit/Q-Branch.git] / examples / sqla-format
CommitLineData
5f3fa0ac 1#!/usr/bin/env perl
2
3use warnings;
4use strict;
5
6use Getopt::Long;
7my $p = Getopt::Long::Parser->new(config => [qw( gnu_getopt no_ignore_case )]);
8my $opts = { profile => 'console', help => \&showhelp };
9$p->getoptions( $opts, qw(
10 profile|p=s
11 help|h
12)) or showhelp();
13
14sub showhelp {
15 require Pod::Usage;
16 Pod::Usage::pod2usage( -verbose => 0, -exitval => 2 );
17}
18
19require SQL::Abstract::Tree;
20my $sqlat = SQL::Abstract::Tree->new({ profile => $opts->{profile}, fill_in_placeholders => 0 });
21
22my $chunk = '';
23my $leftover = '';
24do {
25 $chunk = $leftover . $chunk if length $leftover;
26
27 if ($chunk =~ / \A (.+?) (?:
28 (?<=\S)\:\s+\'[^\n]+ # pasting DBIC_TRACE output directly
29 |
30 \;(?: \s | \z)
31 |
32 \z
33 |
34 ^ \s* (?=SELECT|INSERT|UPDATE|DELETE)
35 ) (.*) /smix) {
36
37 $leftover = $2;
38 print $sqlat->format($1);
39 print "\n";
40 }
41 else {
42 $leftover = $chunk;
43 }
44} while ( (read *STDIN, $chunk, 4096) or length $leftover );
45
46=head1 NAME
47
48sqla-format - An intelligent SQL formatter
49
50=head1 SYNOPSIS
51
52 ~$ sqla-format << log.sql
53
54 ~$ myprogram -v | sqla-format -p html > sqltrace.html
55
56=head1 COPYRIGHT AND LICENSE
57
58This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt.
59
60This is free software; you can redistribute it and/or modify it under
61the same terms as the Perl 5 programming language system itself.