view release on metacpan or  search on metacpan

lib/Alzabo/SQLMaker.pm  view on Meta::CPAN

sub set
{
    my $self = shift;
    my @vals = @_;

    $self->_assert_last_op('update');

    Alzabo::Exception::Params->throw
	( error => "'set' method expects key/value pairs of column objects and values'" )
	    if !@vals || @vals % 2;

    validate_pos( @_, ( { can => 'table' },
			{ type => UNDEF | SCALAR | OBJECT } ) x (@vals / 2) );

    $self->{sql} .= ' SET ';

    my @set;
    my $table = ( keys %{ $self->{tables} } )[0];
    while ( my ($col, $val) = splice @vals, 0, 2 )
    {
	unless ( $table eq $col->table )
	{
	    my $err = 'Cannot set column (';
	    $err .= join '.', $col->table->name, $col->name;
	    $err .= ') unless its table is included in the UPDATE clause';
	    Alzabo::Exception::SQL->throw( error => $err );
	}

	push @set,
	    ( $self->{quote_identifiers} ?
              $self->{driver}->quote_identifier( $col->name ) :
              $col->name ) .
            ' = ' . $self->_bind_val($val);
    }
    $self->{sql} .= join ', ', @set;

    $self->{last_op} = 'set';

    return $self;
}

sub delete
{
    my $self = shift;

    $self->{sql} .= 'DELETE ';

    $self->{type} = 'delete';
    $self->{last_op} = 'delete';

    return $self;
}

sub _assert_last_op
{
    my $self = shift;

    unless ( grep { $self->{last_op} eq $_ } @_ )
    {
	my $op = (caller(1))[3];
	$op =~ s/.*::(.*?)$/$1/;
	Alzabo::Exception::SQL->throw( error => "Cannot follow $self->{last_op} with $op" );
    }
}

use constant _BIND_VAL_FOR_INSERT_SPEC => ( { isa => 'Alzabo::Runtime::Column' },
                                            { type => UNDEF | SCALAR | OBJECT }
                                          );


sub _bind_val_for_insert
{
    my $self = shift;

    my ( $col, $val ) =
        validate_pos( @_, _BIND_VAL_FOR_INSERT_SPEC );

    if ( defined $val && $val eq $placeholder )
    {
        push @{ $self->{placeholders} }, $col->name;
        return '?';
    }
    else
    {
        return $self->_bind_val($val);
    }
}

use constant _BIND_VAL_SPEC => { type => UNDEF | SCALAR | OBJECT };

sub _bind_val
{
    my $self = shift;

    validate_pos( @_, _BIND_VAL_SPEC );

    return $_[0]->as_string( $self->{driver}, $self->{quote_identifiers} )
        if Alzabo::Utils::safe_isa( $_[0], 'Alzabo::SQLMaker::Function' );

    push @{ $self->{bind} }, $_[0];
    return '?';
}

sub sql
{
    my $self = shift;

    Alzabo::Exception::SQL->throw( error => "SQL contains unbalanced parentheses subgrouping: $self->{sql}" )
	if $self->{subgroup};

    return $self->{sql};
}

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

sub placeholders
{
    my $self = shift;

    my $x = 0;

    return map { $_ => $x++ } @{ $self->{placeholders} };
}

sub limit
{
    shift()->_virtual;
}

sub get_limit
{
    shift()->_virtual;
}

sub sqlmaker_id
{
    shift()->_virtual;
}

sub distinct_requires_order_by_in_select { 0 }

sub _virtual
{
    my $self = shift;

    my $sub = (caller(1))[3];
    $sub =~ s/.*::(.*?)$/$1/;
    Alzabo::Exception::VirtualMethod->throw( error =>
					     "$sub is a virtual method and must be subclassed in " . ref $self );
}

sub debug
{
    my $self = shift;
    my $fh = shift;

    print $fh '-' x 75 . "\n";
    print $fh "SQL\n - " . $self->sql . "\n";
    print $fh "Bound values\n";

    foreach my $b ( @{ $self->bind } )
    {
        my $out = $b;

        if ( defined $out )
        {
            if ( length $out > 75 )
            {
                $out = substr( $out, 0, 71 ) . ' ...';
            }
        }
        else
        {
            $out = 'NULL';
        }

        print $fh " - [$out]\n";
    }
}

package Alzabo::SQLMaker::Function;

use Params::Validate qw( :all );
Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } );

sub new
{
    my $class = shift;
    my %p = @_;

    $p{args} = [] unless defined $p{args};
    $p{quote} ||= [];

    return bless \%p, $class;
}

sub allows_alias { shift->{allows_alias} }

sub as_string
{
    my $self = shift;
    my $driver = shift;
    my $quote = shift;

    my @args;
    foreach ( 0..$#{ $self->{args} } )