From: Matt S Trout Date: Thu, 19 Sep 2019 17:33:23 +0000 (+0000) Subject: couple utility scripts X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9bcd623d555fa09aaba7a3ba56b4454002727872;p=scpubgit%2FQ-Branch.git couple utility scripts --- diff --git a/maint/inplace b/maint/inplace new file mode 100755 index 0000000..d8866bd --- /dev/null +++ b/maint/inplace @@ -0,0 +1,15 @@ +use strictures 2; +use autodie; + +my ($cmd, $file, @args) = @ARGV; + +my $input = do { local (@ARGV, $/) = $file; <> }; + +close STDOUT; +open STDOUT, '>', $file; + +open $out, '|-', $cmd, @args; + +print $out $input; + +close $out; diff --git a/maint/podregen b/maint/podregen new file mode 100755 index 0000000..59ad977 --- /dev/null +++ b/maint/podregen @@ -0,0 +1,57 @@ +use strictures 2; +use Data::Dumper::Compact; +use SQL::Abstract::Formatter; +use SQL::Abstract::ExtraClauses; + +my $ddc = Data::Dumper::Compact->new(max_width => 72); +my $sqla = SQL::Abstract::ExtraClauses->new( + lazy_join_sql_parts => 1, +); +my $sqlaf = SQL::Abstract::Formatter->new(max_width => 72); + +while (1) { + my $line = ; + exit 0 unless defined $line; + print $line; + last if $line =~ /\A__END__/; +} + +my $slurp = do { local $/; }; + +my ($expr_re, $aqt_re, $query_re) = + map qr/(?sm:(.*?)( +)(# ${_}\n)(?:\n|(.*?)\n\n))/, qw(expr aqt query); + +sub reformat { + my ($thing, $indent) = @_; + my $thing_ddc = $ddc->dump($thing); + $thing_ddc =~ s/^/$indent/mg; + return $thing_ddc; +} + +sub seval { eval('+('.$_[0].')') or die "seval: $_[0]: $@" } + +while ($slurp =~ m/\G$expr_re/gc) { + my ($pre, $indent, $type, $expr_str) = ($1, $2, $3, $4); + print $pre.$indent.$type; + print reformat(my $expr = seval($expr_str), $indent); + print "\n"; + if ($slurp =~ m/\G$aqt_re/gc) { + my ($apre, $aindent, $atype) = ($1, $2, $3); + print $apre.$aindent.$atype; + print reformat($sqla->expand_expr($expr), $aindent); + print "\n"; + } + die unless $slurp =~ m/\G$query_re/g; + my ($qpre, $qindent, $qtype) = ($1, $2, $3); + print $qpre.$qindent.$qtype; + my ($sql, @bind) = $sqla->render_statement($expr); + my $fsql = $sqlaf->format(@$sql); + $fsql =~ s/^/$indent/mg; + print $fsql."\n"; + print reformat(\@bind, $qindent); + print "\n"; +} + +$slurp =~ /\G(.*)$/sm; + +print $1;