File Coverage

blib/lib/SQL/Object.pm

Criterion	Covered	Total	%
statement	65	78	83.3
branch	9	14	64.2
condition	1	3	33.3
subroutine	22	25	88.0
pod	9	11	81.8
total	106	131	80.9

package SQL::Object;
use strict;
use warnings;
use utf8;
use Exporter qw/import/;

our @EXPORT_OK = qw/sql_obj sql_type/;

use overload
    '&'  => sub { $_[0]->compose_and($_[1]) },
    '|'  => sub { $_[0]->compose_or($_[1])  },
    '+'  => sub { $_[0]->join($_[1])        },
    '""' => sub { $_[0]->as_sql             },
    fallback => 1
;

our $VERSION = '0.01';

sub sql_obj {
    my ($sql, $args) = @_;

    my $bind;
    if (ref($args) eq 'HASH') {
        my %named_bind = %{$args};
        $sql =~ s{:(\w+)}{
            Carp::croak("$1 does not exists in hash") if !exists $named_bind{$1};
            if ( ref $named_bind{$1} && ref $named_bind{$1} eq "ARRAY" ) {
                push @$bind, @{ $named_bind{$1} };
                my $tmp = join ',', map { '?' } @{ $named_bind{$1} };
                "($tmp)";
            } else {
                push @$bind, $named_bind{$1};
                '?'
            }
        }ge;
    }
    else {
        $bind = ref($args) eq 'ARRAY' ? $args : [$args];
    }

    SQL::Object->new(sql => $sql, bind => $bind);
}

sub sql_type {
    my ($value_ref, $type) = @_;
    SQL::Object::Type->new(value_ref => $value_ref, type => $type);
}

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

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

    $self->{sql} = $self->{sql} . " $op " . $sql;
    $self->{bind} = [@{$self->{bind}}, @$bind];
    $self;
}

sub and {
    my ($self, $sql, @bind) = @_;
    $self->_compose('AND', $sql, \@bind);
}

sub or {
    my ($self, $sql, @bind) = @_;
    $self->add_parens->_compose('OR', $sql, \@bind);
}

sub join {
    my ($self, $other) = @_;
    $self->{sql} = $self->{sql} . $other->{sql};
    $self->{bind} = [@{$self->{bind}}, @{$other->{bind}}];
    $self;
}

sub compose_and {
    my ($self, $other) = @_;
    $self->and($other->{sql}, @{$other->{bind}});
}

sub compose_or  {
    my ($self, $other) = @_;
    $self->or($other->add_parens->as_sql, @{$other->{bind}});
}

sub add_parens {
    my $self = shift;
    $self->{sql} = '('.$self->{sql}.')';
    $self;
}

sub as_sql { $_[0]->{sql} }
sub bind   { wantarray ? @{$_[0]->{bind}} : $_[0]->{bind} }

package # hide from PAUSE
     SQL::Object::Type;

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

sub value     { ${$_[0]->{value_ref}} }
sub value_ref { $_[0]->{value_ref}    }
sub type      { $_[0]->{type}         }

1;
__END__