maint/podregen

   1 use strictures 2;
   2 use Data::Dumper::Compact;
   3 use SQL::Abstract::Formatter;
   4 use SQL::Abstract::ExtraClauses;
   5
   6 my $ddc = Data::Dumper::Compact->new(max_width => 72);
   7 my $sqla = SQL::Abstract::ExtraClauses->new(
   8   lazy_join_sql_parts => 1,
   9 );
  10 my $sqlaf = SQL::Abstract::Formatter->new(max_width => 72);
  11
  12 while (1) {
  13   my $line = <STDIN>;
  14   exit 0 unless defined $line;
  15   print $line;
  16   last if $line =~ /\A__END__/;
  17 }
  18
  19 my $slurp = do { local $/; <STDIN> };
  20
  21 my ($expr_re, $aqt_re, $query_re) =
  22   map qr/(?sm:(.*?)( +)(# ${_}\n)(?:\n|(.*?)\n\n))/, qw(expr aqt query);
  23
  24 sub reformat {
  25   my ($thing, $indent) = @_;
  26   my $thing_ddc = $ddc->dump($thing);
  27   $thing_ddc =~ s/^/$indent/mg;
  28   return $thing_ddc;
  29 }
  30
  31 sub seval { eval('+('.$_[0].')') or die "seval: $_[0]: $@" }
  32
  33 while ($slurp =~ m/\G$expr_re/gc) {
  34   my ($pre, $indent, $type, $expr_str) = ($1, $2, $3, $4);
  35   print $pre.$indent.$type;
  36   print reformat(my $expr = seval($expr_str), $indent);
  37   print "\n";
  38   if ($slurp =~ m/\G$aqt_re/gc) {
  39     my ($apre, $aindent, $atype) = ($1, $2, $3);
  40     print $apre.$aindent.$atype;
  41     print reformat($sqla->expand_expr($expr), $aindent);
  42     print "\n";
  43   }
  44   die unless $slurp =~ m/\G$query_re/g;
  45   my ($qpre, $qindent, $qtype) = ($1, $2, $3);
  46   print $qpre.$qindent.$qtype;
  47   my ($sql, @bind) = $sqla->render_statement($expr);
  48   my $fsql = $sqlaf->format(@$sql);
  49   $fsql =~ s/^/$indent/mg;
  50   print $fsql."\n";
  51   print reformat(\@bind, $qindent);
  52   print "\n";
  53 }
  54
  55 $slurp =~ /\G(.*)$/sm;
  56
  57 print $1;