File Coverage

blib/lib/Class/ReluctantORM/SQL/Param.pm

Criterion	Covered	Total	%
statement	21	69	30.4
branch	0	24	0.0
condition	0	8	0.0
subroutine	7	16	43.7
pod	8	8	100.0
total	36	125	28.8

package Class::ReluctantORM::SQL::Param;

=head1 NAME

Class::ReluctantORM::SQL::Param - Represent a placeholder in a SQL statement

=head1 SYNOPSIS

  use Class::ReluctantORM::SQL::Aliases;

  # Make a placeholder
  my $param = Param->new();

  # Set and read a value to the param
  $param->bind_value('foo');
  $param->bind_value(undef);  # This binds NULL
  my $val =  $param->bind_value();

  # Use the param in a Where criterion ('foo = ?')
  my $crit = Criterion->new('=', Column->new(column => 'foo'), $p);


=head1 DESCRIPTION

Represents a placeholder in a SQL statement.

=cut

use strict;
use warnings;

use Data::Dumper;
use Class::ReluctantORM::Exception;
use Class::ReluctantORM::Utilities qw(install_method);
use Scalar::Util qw(looks_like_number);

use base 'Class::ReluctantORM::SQL::Expression';
our $DEBUG = 0;

=head1 CONSTRUCTOR

=cut

=head2 $p = Param->new();

=head2 $p = Param->new($value);

=head2 $p = Param->new(undef);

Makes a new param object.

In the first form, no value is bound.

In the second form, the given value is bound.

In the third form, the NULL value is bound.

=cut

sub new {
    my $class = shift;
    my $self = bless {}, $class;

    if (@_) {
        $self->bind_value(@_);
    }

    return $self;
}



=head1 ACCESSORS and MUTATORS

=cut

=head2 $v = $p->bind_value();

=head2 $p->bind_value($value);

=head2 $p->bind_value(undef);

Reads or sets the value used in Driver parameter binding.

In the first form, the value, if any, is returned.  An undefined value is ambiguous;
use has_bind_Value to detect a bind value.

In the second form, the bind value is set to the scalar provided.

In the third form, the bind value is set to undef, which means it will be interpreted by the Driver as NULL.

=cut

sub bind_value {
    my $self = shift;
    if (@_) {
        $self->has_bind_value(1);
        my $value = shift;
        unless (!defined($value) || !ref($value)) {
            Class::ReluctantORM::Exception::Param::WrongType->croak(
                                                       error => 'bind_Value must be a either a scalar or undef',
                                                       expected => 'scalar',
                                                       value => $value,
                                                      );
        }
        if (@_) {
            Class::ReluctantORM::Exception::Param::Spurious->croak();
        }
        $self->set('bind_value', $value);
    }
    return $self->get('bind_value');
}


=head2 @empty = $p->child_expressions();

Always returns an empty list.  Required by the Expression interface.

=cut

sub child_expressions { return (); }

=head2 $bool = $p->has_bind_value()

If true a bind value has been set.  Don't
rely on bind_value(), as undef is a valid value.

=cut

__PACKAGE__->mk_accessors(qw(has_bind_value));

=head2 $bool = $arg->is_param();

All objects of this class return true.  The class add this method to its parent class, making all other subclasses of return false.

=cut

install_method('Class::ReluctantORM::SQL::Expression', 'is_param', sub { return 0; });
sub is_param { return 1; }


=head2 $bool = $p->is_leaf_expression();

Always returns true for this class.  Required by the Expression interface.

=cut

sub is_leaf_expression { return 1; }

=head2 $str = $param->pretty_print();

Renders a human-readable representation of the Param.

=cut

sub pretty_print {
    my $self = shift;
    my %args = @_;
    if ($args{one_line}) {
        my $str = '?';
        if ($self->has_bind_value) {
            $str .= '(bind:';
            my $val = $self->bind_value();
            if (!defined($val)) {
                $str .= 'NULL';
            } elsif (looks_like_number($val)) {
                $str .= $val;
            } else {
                $str .= "'" . $val . "'";
            }
            $str .= ')';
        }
        return $str;
    } else {
        return ($args{prefix} || '' ) . 'PARAM ' . $self->pretty_print(one_line => 1) . "\n";
    }
}

=head2 $clone = $p->clone();

Creates a new Param, copying the bound value of the original if it had one.

=cut

sub clone {
    my $self = shift;
    my $class = ref $self;
    if ($self->has_bind_value) {
        return $class->new($self->bind_value());
    } else {
        return $class->new();
    }
}

=head2 $bool = $param->is_equivalent($expr);

Returns true if $expr is a Param, with matching has_bind_value() and value.

=cut

sub is_equivalent {
    my $left = shift;
    my $right = shift;
    unless ($right->is_param()) { return 0; }

    if ($left->has_bind_value()) {
        unless ($right->has_bind_value()) { return 0; }
        my ($lbv, $rbv) = ($left->bind_value(), $right->bind_value());
        return (
                (!defined($lbv) && !defined($rbv)) # both undef
                ||
                ((defined($lbv) && defined($rbv)) && ($lbv == $rbv)) # both defined and equal
               );
    } else {
        return !$right->has_bind_value();
    }
}


=head1 AUTHOR

Clinton Wolfe

=cut

1;