File Coverage

blib/lib/SQL/Wizard/Expr.pm

Criterion	Covered	Total	%
statement	67	68	98.5
branch	8	10	80.0
condition	5	9	55.5
subroutine	26	27	96.3
pod	0	8	0.0
total	106	122	86.8

package SQL::Wizard::Expr;

use strict;
use warnings;
use Carp;
use Scalar::Util qw(blessed);
use SQL::Wizard::Expr::Alias;
use SQL::Wizard::Expr::Order;
use SQL::Wizard::Expr::Window;
use SQL::Wizard::Expr::BinaryOp;
use SQL::Wizard::Expr::Value;

use overload
  '+'    => sub { _binop('+',  @_) },
  '-'    => sub { _binop('-',  @_) },
  '*'    => sub { _binop('*',  @_) },
  '/'    => sub { _binop('/',  @_) },
  '%'    => sub { _binop('%',  @_) },
  '""'   => sub { croak "Cannot stringify SQL::Wizard::Expr directly; use ->to_sql" },
  'bool' => sub { 1 },
  fallback => 1;

sub new {
  my ($class, %args) = @_;
  bless \%args, $class;
}

sub to_sql {
  my ($self, $renderer) = @_;
  $renderer ||= $self->{_renderer};
  croak "No renderer available" unless $renderer;
  $renderer->render($self);
}

sub as {
  my ($self, $alias) = @_;
  croak "alias must be a word (\\w+), got '$alias'" unless $alias =~ /^\w+$/;
  SQL::Wizard::Expr::Alias->new(
    expr      => $self,
    alias     => $alias,
    _renderer => $self->{_renderer},
  );
}

sub asc {
  my ($self) = @_;
  SQL::Wizard::Expr::Order->new(
    expr      => $self,
    direction => 'ASC',
    _renderer => $self->{_renderer},
  );
}

sub desc {
  my ($self) = @_;
  SQL::Wizard::Expr::Order->new(
    expr      => $self,
    direction => 'DESC',
    _renderer => $self->{_renderer},
  );
}

sub asc_nulls_first {
  my ($self) = @_;
  SQL::Wizard::Expr::Order->new(
    expr      => $self,
    direction => 'ASC',
    nulls     => 'FIRST',
    _renderer => $self->{_renderer},
  );
}

sub desc_nulls_last {
  my ($self) = @_;
  SQL::Wizard::Expr::Order->new(
    expr      => $self,
    direction => 'DESC',
    nulls     => 'LAST',
    _renderer => $self->{_renderer},
  );
}

sub over {
  my ($self, @args) = @_;
  # over('window_name') or over(-partition_by => ..., -order_by => ...)
  my $spec;
  if (@args == 1 && !ref $args[0]) {
    $spec = { name => $args[0] };
  } else {
    my %opts = @args;
    $spec = \%opts;
  }
  SQL::Wizard::Expr::Window->new(
    expr      => $self,
    spec      => $spec,
    _renderer => $self->{_renderer},
  );
}

sub _binop {
  my ($op, $left, $right, $swap) = @_;
  # Coerce plain values to Value nodes
  $right = _coerce($right, $left);
  ($left, $right) = ($right, $left) if $swap;
  SQL::Wizard::Expr::BinaryOp->new(
    op        => $op,
    left      => $left,
    right     => $right,
    _renderer => $left->{_renderer},
  );
}

sub _coerce {
  my ($thing, $ref_expr) = @_;
  return $thing if blessed($thing) && $thing->isa('SQL::Wizard::Expr');
  SQL::Wizard::Expr::Value->new(
    value     => $thing,
    _renderer => $ref_expr->{_renderer},
  );
}

1;