File Coverage

blib/lib/DBIx/RoboQuery.pm

Criterion	Covered	Total	%
statement	116	117	99.1
branch	51	56	91.0
condition	12	15	80.0
subroutine	28	28	100.0
pod	17	17	100.0
total	224	233	96.1

# vim: set ts=2 sts=2 sw=2 expandtab smarttab:
#
# This file is part of DBIx-RoboQuery
#
# This software is copyright (c) 2010 by Randy Stauner.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
use strict;
use warnings;

package DBIx::RoboQuery;
{
  $DBIx::RoboQuery::VERSION = '0.032';
}
# git description: v0.031-6-gaa2e204

BEGIN {
  $DBIx::RoboQuery::AUTHORITY = 'cpan:RWSTAUNER';
}
# ABSTRACT: Very configurable/programmable query object

use Carp qw(carp croak);
use DBIx::RoboQuery::ResultSet ();
use DBIx::RoboQuery::Util ();
use Template 2.22; # Template Toolkit

# no warnings 'once';
my $_template_stash_private = $Template::Stash::PRIVATE;


sub new {
  my $class = shift;
  my %opts = @_ == 1 ? %{ $_[0] } : @_;

  # Params::Validate not currently warranted
  # (since it's still missing the "mutually exclusive" feature)

  # defaults
  my $self = {
    drop_columns => [],
    key_columns => [],
    resultset_class => "${class}::ResultSet",
    variables => {},
    template_tr_name => 'template',
  };

  bless $self, $class;

  foreach my $var ( $self->_pass_through_args() ){
    $self->{$var} = $opts{$var} if exists($opts{$var});
  }

  DBIx::RoboQuery::Util::_ensure_arrayrefs($self);

  croak(q|Cannot include both 'sql' and 'file'|)
    if exists($opts{sql}) && exists($opts{file});

  # if the string is defined that's good enough
  if( defined($opts{sql}) ){
    $self->{template} = ref($opts{sql}) ? ${$opts{sql}} : $opts{sql};
  }
  # the file path should at least be a true value
  elsif( my $f = $opts{file} ){
    open(my $fh, '<', $f)
      or croak("Failed to open '$f': $!");
    $self->{template} = do { local $/; <$fh>; };
  }
  else {
    croak(q|Must specify one of 'sql' or 'file'|);
  }

  $self->prepare_transformations();

  $self->{tt} ||= Template->new({
    ABSOLUTE => 1,
    STRICT => 1,
    VARIABLES => {
      query => $self,
      %{$self->{variables}}
    },
    %{ $self->{template_options} || {} },
  })
    or die "$class error: Template::Toolkit failed: $Template::ERROR\n";

  return $self;
}

# convenience method for subclasses

sub _arrayref_args {
  qw(
    bind_params
    drop_columns
    key_columns
    order
  );
}


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

  my $bound = $self->{bind_params} ||= [];

  # auto-increment placeholder index unless all three values were passed
  unshift @bind, ++$self->{bind_params_index}
    unless @bind == 3;

  # always push (don't set $bound->[$index]) because we're just going
  # to pass all of these to bind_param() in order
  push @$bound, \@bind;

  # convenience for putting directly into place in sql
  return $bind[0] =~ /^\d+$/ ? '?' : $bind[0];
}


sub bound_params {
  return @{ $_[0]->{bind_params} || [] };
}


sub bound_values {
  return map { $_->[1] } $_[0]->bound_params;
}


sub drop_columns {
  my ($self) = shift;
  $self->{drop_columns} = [DBIx::RoboQuery::Util::_flatten(@_)]
    if @_;
  return @{$self->{drop_columns}};
}


sub key_columns {
  my ($self) = shift;
  $self->{key_columns} = [DBIx::RoboQuery::Util::_flatten(@_)]
    if @_;
  return @{$self->{key_columns}};
}


sub order {
  my ($self) = shift;
  if( @_ ){
    $self->{order} = [DBIx::RoboQuery::Util::_flatten(@_)]
  }
  # only if not previously set (empty arrayref counts as being set)
  elsif( !$self->{order} ){
    $self->{order} = [
      DBIx::RoboQuery::Util::order_from_sql(
        $self->sql, $self)
    ]
  }
  return @{$self->{order}};
}

# convenience method: args allowed in the constructor

sub _pass_through_args {
  (
    $_[0]->_arrayref_args,
  qw(
    dbh
    default_slice
    prefix
    resultset_class
    squeeze_blank_lines
    suffix
    template_options
    transformations
    template_private_vars
    template_tr_name
    variables
  ));
}


sub prepare_transformations {
  my ($self) = @_;

  return
    unless my $tr = $self->{transformations};

  # assume a simple hash is a hash of named subs
  if( ref $tr eq 'HASH' ){
    require Sub::Chain::Group;

    # the name of the template func can be changed (or disabled)
    if( my $tr_name = $self->{template_tr_name} ){
      # add the template callback to the subs (with $self embedded)
      $tr = {
        %$tr,
        $tr_name => $self->template_tr_callback,
      }
        if ! exists $tr->{ $tr_name };
    }

    $self->{transformations} =
      Sub::Chain::Group->new(
        chain_class => 'Sub::Chain::Named',
        chain_args  => {subs => $tr},
        hook_as_hash => 1,
      );
  }

  # return nothing
  return;
}


sub pre_process_sql {
  my ($self, $sql) = @_;
  $sql = $self->{prefix} . $sql if defined $self->{prefix};
  $sql = $sql . $self->{suffix} if defined $self->{suffix};
  return $sql;
}


sub prefer {
  my ($self) = shift;
  push(@{ $self->{preferences} ||= [] }, @_);
}

sub _process_template {
  my ($self, $template, $vars) = @_;
  my $output = '';

  # this is a regexp for vars that are considered private (will appear undef in template)
  local $Template::Stash::PRIVATE = $self->{template_private_vars}
    if exists $self->{template_private_vars};

  $self->{tt}->process($template, $vars, \$output)
    or die($self->{tt}->error(), "\n");

  return $output;
}


sub resultset {
  my ($self) = shift;
  # cache this object to avoid confusion
  return $self->{resultset} ||= do {
    # taint check
    (my $class = $self->{resultset_class}) =~ s/[^a-zA-Z0-9_:']+//g;
    # make sure it's loaded first
    eval "require $class";
    die $@ if $@;

    $class->new($self);
  }
}


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

  # Cache the result to avoid duplicating function calls,
  # directives, template logic, etc.
  # Plus it shouldn't need to be run more than once.
  if( exists $self->{processed_sql} ){
    $output = $self->{processed_sql};
  }
  else {
    $vars ||= {};
    my $sql = $self->pre_process_sql($self->{template});
    $output = $self->_process_template(\$sql, $vars);

    # this is fairly naive, but for SQL would usually be fine
    $output =~ s/\n\s*\n+/\n/g
      if $self->{squeeze_blank_lines};

    $self->{processed_sql} = $output;
  }
  return $output;
}


sub transform {
  my ($self, @tr) = @_;

  croak("Cannot transform without 'transformations'")
    unless my $tr = $self->{transformations};

  $tr->append(@tr);
}

# shortcuts


sub tr_fields {
  my ($self, $name, $fields, @args) = @_;
  return $self->transform($name, fields => $fields, args => [@args]);
}

sub tr_groups {
  my ($self, $name, $groups, @args) = @_;
  return $self->transform($name, groups => $groups, args => [@args]);
}


sub tr_row {
  my ($self, $name, $hooks, @args) = @_;
  return $self->transform($name, hooks => $hooks, args => [@args]);
}


sub template_tr_callback {
  my ($self) = @_;
  return sub {
    my ($row, $template) = @_;
    # (updating the hash should work, but if not this would: '[% _save_row(row) %]')
    $template = '[% ' . $template . ' %]';
    $self->_process_template(\$template, {row => $row});
    return $row;
  };
}

1;

__END__