maint/podregen

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