maint/podregen

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