#!/usr/bin/perl -l
use strict;
use warnings;

use PSQL::Query::Handle;
use IO::Handle;
use Getopt::Long;

our ( $fmt_oppr, $fmt_info, $dom_char );
my $result = GetOptions (
	'printf=s'        => \$fmt_oppr
	, 'printf-info=s' => \$fmt_info
	, 'dom-char=s'    => \$dom_char
);

$fmt_oppr = '%s' unless $fmt_oppr or $fmt_info;

foreach ( $fmt_oppr, $fmt_info ) {
	next unless defined;
	s/ \\n / \n /gxo;
	s/ \\t / \t /gxo;
}

my $io = IO::Handle->new_from_fd( 'STDIN', "r" );
my $query = PSQL::Query::Handle->new({ handle => $io });

while ( my $row = $query->shift_row ) {

	if ( $fmt_oppr ) {
		my $fmt_oppr = $fmt_oppr;

		## Source/Name
		## Estimate Startup/Total/Rows/Width
		## Actual Startup/Total/Rows/Width
		$fmt_oppr =~ s/
			%( [snd] | e[strw] | a[strl] )
			/ _lookup_oppr( $row, $1 )
			/gex
		;

		## You might not always have something
		## Case: user requests ANALYZE and does only EXPLAIN
		print $fmt_oppr if $fmt_oppr;

	}

	if ( $fmt_info ) {
		while ( my $row = $row->shift_info ) {
			my $fmt_info = $fmt_info;

			## Info Name/Verbose/Src
			$fmt_info =~ s/
				%( [nsv] )
				/ _lookup_opprInfo( $row, $1 )
				/gex
			;

			print $fmt_info;

		}
	}

}

sub _lookup_oppr {
	my ( $row, $lookup ) = @_;

	my ( $obj, $modifier ) = split '', $lookup;

	my $return = {

		##
		## Row
		##
		n   => sub { $row->name       }
		, s => sub { $row->src        }
		, d => sub { $dom_char ? $dom_char x $row->dom_level : $row->dom_level  }

		, e => sub {
			my $t = $row->cost;
			return sub {
				+{
					s   => sub { $t->startup }
					, t => sub { $t->total   }
					, r => sub { $t->rows    }
					, w => sub { $t->width   }
				}
			};
		}

		, a => sub {
			my $t = $row->time;
			return sub {
				+{
					s   => sub { $t->startup }
					, t => sub { $t->total   }
					, r => sub { $t->rows    }
					, l => sub { $t->loops   }
				}
			}
		}

	};

	## returns form func if the user request analyze info
	## and has only explain info
	return if $obj eq 'a' and not $row->has_time;

	$modifier ?
		$return->{$obj}->()->()->{$modifier}->()
		: $return->{$obj}->()
	;

}

sub _lookup_opprInfo {
	my ( $row, $obj ) = @_;

	my $return = {
		n   => sub { $row->name    }
		, v => sub { $row->verbose }
		, s => sub { $row->src     }
	};

	$return->{$obj}->();

}

1;

__END__

=head1 NAME

psql-plus - Utility to enhance the functionality of psql

=head1 SYNOPSIS

	echo EXPLAIN SELECT * FROM <table> | psql -d <database> | psql-plus --printf "%n"

	psql -d database
	\o|psql-plus --printf "%n"
	EXPLAIN SELECT * FROM <table>
	EXPLAIN SELECT * FROM <other table>
	^D

	psql-plus --dom-char x --printf "%d"

=head1 DESCRIPTION

=head2 Arguments

=over 5

=item --dom-char ( graphic char for dom-level '%d' representation )

=item --printf ( Operation Row )

	%n = name
	%s = src
	%d = dom_level ( see notes below )

	%e*  explain/estimate
	%a*  actual

	%es = Estimate startup
	%et = Estimate total
	%er = Estimate rows
	%ew = Estimate width

	%as = Actual (time) Startup
	%at = Actual (time) Total
	%ar = Actual Rows
	%al = Actual Loops

* dom_level: If you run an explain this is the whitespace significant portion from the left-margin to the first \S.

=item --printf-info ( OperationInfo Row )

	%n = Info name
	%v = Info verbose (not currently further parsed)
	%s = Source (unmodified)

=back

=head2 PSQL::Query

This is currently just a script for the L<PSQL::Query> library. All of the voodoo happens there.

=head2 Not-yet-implimented --lookforward-to

Roadmap to .01:

=over 5

=item * automatic opt-in posting to pastbins (DWIM). syn: C<--pastbin [rafb|sial|pastbin]>

=item * the ability to return a url only when posting to a pastbin. syn: C<--url-only>

=item * XML exportation syn: C<--format=XML> / syntax highlighting (tentative)

=back

Roadmap to .02:

=over 5

=item * expansion of PSQL:: to encompass more postgres-specific functionality, the use of a new lib other than L<PSQL::Query>

=back

=head1 BUGS

Email me they will get fixed in .05 seconds, or you can sue someone else.

=head1 CAVEATS

Currently limited to "Enhancing" only the functionality of EXPLAIN and EXPLAIN ANALYZE

=head1 COPYRIGHT

Artistic or GPL, like 99.9% of CPAN-distributed stuff.

=head1 AVAILABILITY

CPAN

L<http://repo.or.cz/w/Pqsl-Perl.git>

=head1 AUTHOR

Evan Carroll <me at evancarroll.com>

=cut