insert select/rowvalues clauses, with and with_recursive
[scpubgit/Q-Branch.git] / maint / podregen
CommitLineData
cd979d19 1#!/usr/bin/env perl
2
514d92f1 3use lib 'lib';
9bcd623d 4use strictures 2;
5use Data::Dumper::Compact;
d36cb439 6use Devel::DDCWarn;
9bcd623d 7use SQL::Abstract::Formatter;
6bbc99c8 8use SQL::Abstract;
9bcd623d 9use SQL::Abstract::ExtraClauses;
10
11my $ddc = Data::Dumper::Compact->new(max_width => 72);
6bbc99c8 12my $sqla = SQL::Abstract->new(
9bcd623d 13 lazy_join_sql_parts => 1,
14);
6bbc99c8 15SQL::Abstract::ExtraClauses->apply_to($sqla);
9bcd623d 16my $sqlaf = SQL::Abstract::Formatter->new(max_width => 72);
17
18while (1) {
19 my $line = <STDIN>;
20 exit 0 unless defined $line;
21 print $line;
22 last if $line =~ /\A__END__/;
23}
24
25my $slurp = do { local $/; <STDIN> };
26
27my ($expr_re, $aqt_re, $query_re) =
28 map qr/(?sm:(.*?)( +)(# ${_}\n)(?:\n|(.*?)\n\n))/, qw(expr aqt query);
29
30sub reformat {
31 my ($thing, $indent) = @_;
32 my $thing_ddc = $ddc->dump($thing);
33 $thing_ddc =~ s/^/$indent/mg;
34 return $thing_ddc;
35}
36
37sub seval { eval('+('.$_[0].')') or die "seval: $_[0]: $@" }
38
39while ($slurp =~ m/\G$expr_re/gc) {
40 my ($pre, $indent, $type, $expr_str) = ($1, $2, $3, $4);
41 print $pre.$indent.$type;
42 print reformat(my $expr = seval($expr_str), $indent);
43 print "\n";
6bbc99c8 44 die unless $slurp =~ m/\G$query_re/g;
45 my ($qpre, $qindent, $qtype) = ($1, $2, $3);
46 if ($qpre =~ s/\A$aqt_re//) {
9bcd623d 47 my ($apre, $aindent, $atype) = ($1, $2, $3);
48 print $apre.$aindent.$atype;
49 print reformat($sqla->expand_expr($expr), $aindent);
50 print "\n";
51 }
9bcd623d 52 print $qpre.$qindent.$qtype;
53 my ($sql, @bind) = $sqla->render_statement($expr);
6bbc99c8 54 my $fsql = (ref($sql) ? $sqlaf->format(@$sql) : $sql);
e376aa80 55 s/^/$indent/mg, s/\n+\Z// for $fsql;
9bcd623d 56 print $fsql."\n";
57 print reformat(\@bind, $qindent);
58 print "\n";
59}
60
61$slurp =~ /\G(.*)$/sm;
62
63print $1;