File Coverage

blib/lib/Querylet/Query.pm

Criterion	Covered	Total	%
statement	137	148	92.5
branch	46	50	92.0
condition	3	4	75.0
subroutine	33	35	94.2
pod	32	32	100.0
total	251	269	93.3

use strict;
use warnings;
package Querylet::Query;
{
  $Querylet::Query::VERSION = '0.401';
}
# ABSTRACT: renders and performs queries for Querylet

## no critic RequireCarping

use Carp ();


sub new {
	bless {
		bind_parameters => [],
		output_type => 'csv',
		input_type  => 'term'
	} => (shift);
}


sub set_dbh {
	my $self = shift;
	my $dbh = shift;
	$self->{dbh} = $dbh;
}


sub set_query {
	my ($self, $sql) = @_;

	$self->{query} = $sql;
}


sub bind { ## no critic Homonym
	my ($self, @parameters) = @_;
	$self->{bind_parameters} = [ @parameters ];
}


sub bind_more {
	my ($self, @parameters) = @_;
	push @{$self->{bind_parameters}}, @parameters;
}


sub set_query_vars {
	my ($self, $vars) = @_;

	$self->{query_vars} ||= {};
	$self->{query_vars} = { %{$self->{query_vars}}, %$vars };
}


sub render_query {
	my $self = shift;
	my $rendered_query;

	require Template;
	my $tt = new Template;
	$tt->process(\($self->{query}), $self->{query_vars}, \$rendered_query);

	return $rendered_query;
}


sub run {
	my $self = shift;

	$self->{query} = $self->render_query if $self->{query_vars};

	my $sth = $self->{dbh}->prepare($self->{query});
	   $sth->execute(@{$self->{bind_parameters}});

	$self->{columns} = $sth->{NAME};

	$self->{results} = $sth->fetchall_arrayref({});
}


sub results {
	my $self = shift;
	return $self->{results} if $self->{results};
	$self->run;
}


sub set_results {
	my $self = shift;
	$self->{results} = shift;
}


sub columns {
	my $self = shift;
	return $self->{columns} if $self->{columns};
	$self->run;
	return $self->{columns};
}


sub set_columns {
	my $self = shift;
	$self->{columns} = shift;
}


sub header {
	my $self   = shift;
	my $column = shift;
	return exists $self->{headers}{$column}
		? $self->{headers}{$column}
		: $column;
}


sub set_headers {
	my $self    = shift;
	my $headers = shift;
	while (my ($column, $header) = each %$headers) {
		$self->{headers}{$column} = $header;
	}
}


sub option {
	my ($self, $option_name) = @_;
	return $self->scratchpad->{$option_name} unless @_ > 2;
	return $self->scratchpad->{$option_name} = $_[2];
}


sub scratchpad {
	my $self = shift;
	$self->{scratchpad} = {} unless $self->{scratchpad};
	return $self->{scratchpad};
}


my %input_handler;

sub input_type {
	my $self = shift;
	return $self->{input_type} unless @_;
	return $self->{input_type} = shift;
}


sub input {
	my ($self, $parameter) = @_;

	$self->{input} = {} unless $self->{input};
	return $self->{input}->{$parameter} if exists $self->{input}->{$parameter};

	unless ($input_handler{$self->input_type}) {
		warn "unknown input type: ", $self->input_type," \n";
		return;
	} else {
		$input_handler{$self->input_type}->($self, $parameter);
	}
}


sub register_input_handler {
	shift;
	my ($type, $handler) = @_;
	$input_handler{$type} = $handler;
}


sub output_filename {
	my $self = shift;
	return $self->{output_filename} unless @_;

	my $filename = shift;

	$self->write_type($filename ? 'file' : undef);
	return $self->{output_filename} = $filename;
}


my %write_handler;

sub write_type {
	my $self = shift;
	return $self->{write_type} unless @_;
	return $self->{write_type} = shift;
}


my %output_handler;

sub output_type {
	my $self = shift;
	return $self->{output_type} unless @_;
	return $self->{output_type} = shift;
}


sub output {
	my $self = shift;

	return $self->{output} if exists $self->{output};

	unless ($output_handler{$self->output_type}) {
		warn "unknown output type: ", $self->output_type," \n";
		return;
	} else {
		$self->{output} = $output_handler{$self->output_type}->($self);
		unless ($self->{output}) {
			warn "no output received from output handler!\n";
			return;
		}
		return $self->{output};
	}
}


sub write { ## no critic Homonym
	my ($self) = @_;

	$self->write_type('stdout') unless $self->write_type;

	unless ($write_handler{$self->write_type}) {
		warn "unknown write type: ", $self->write_type," \n";
		return;
	} else {
		$write_handler{$self->write_type}->($self);
	}
}


sub write_output {
	my ($self) = @_;
	my $output = $self->output;

	if (ref $output eq 'CODE') {
		warn "using coderef output, but write_type set\n" if $self->write_type;
		$output->($self->output_filename);
	} else {
		$self->write($self);
	}
}


sub register_output_handler {
	shift;
	my ($type, $handler) = @_;
	$output_handler{$type} = $handler;
}


__PACKAGE__->register_output_handler(csv   => \&as_csv);
sub as_csv {
	my $q = shift;
	my $csv;
	my $results = $q->results;
	my $columns = $q->columns;
	$csv = join(q{,}, map { $q->header($_) } @$columns) . "\n";
	foreach my $row (@$results) {
		$csv .= join(q{,},
              map { (my $v = defined $_ ? $_ : q{}) =~ s/"/\\"/g; qq!"$v"! }
              @$row{@$columns}
            )
         .  "\n";
	}

	return $csv;
}


__PACKAGE__->register_output_handler(template => \&as_template);
__PACKAGE__->register_output_handler(html     => \&as_template);
sub as_template {
	my $query = shift;
	my $output;
	my $template = $query->option('template_file');
	unless ($template) {
		$template = \(<<'END')


    results of query


    [% FOREACH column = query.columns -%][%- END %][% END %]  




288




 





 





 





 





 





 



        




289




 





 





 





 





 





 



       [% FOREACH column = query.columns %] 




290




 





 





 





 





 





 



         [% query.header(column) %] 




291




 





 





 





 





 





 



       [% END %] 




292




 





 





 





 





 





 



        




293




 





 





 





 





 





 



       [% FOREACH row = query.results %] 




294




 





 





 





 





 





 



       [%- row.$column -%]




295

      [% FOREACH column = query.columns %]

      [% END %]

      [% FOREACH row = query.results %]




END
	}

	require Template;
	my $tt = new Template({ RELATIVE => 1});
	$tt->process($template, { query => $query }, \$output);
	return $output;
}


sub register_write_handler {
	shift;
	my ($type, $handler) = @_;
	$write_handler{$type} = $handler;
}


__PACKAGE__->register_write_handler(file => \&to_file);
sub to_file {
	my ($query) = @_;

	if ($query->output_filename) {
		if (open(my $output_file, '>', $query->output_filename)) {
			binmode $output_file;
			print $output_file $query->output;
			close $output_file;
		} else {
			warn "can't open " . $query->output_filename . " for output\n";
			return;
		}
	}
}


__PACKAGE__->register_write_handler(stdout => \&to_stdout);
sub to_stdout {
	my ($query) = @_;
	print $query->output || '';
}


__PACKAGE__->register_input_handler(term => \&from_term);
sub from_term {
	my ($q, $parameter) = @_;

	print "enter $parameter: ";
	my $value = ;
	chomp $value;
	$q->{input}->{$parameter} = $value;
}


"I do endeavor to give satisfaction, sir.";

__END__