AlignDB-SQL

 view release on metacpan or  search on metacpan

README  view on Meta::CPAN

        my $sql = AlignDB::SQL->new();
        $sql->select([ 'id', 'name', 'bucket_id', 'note_id' ]);
        $sql->from([ 'foo' ]);
        $sql->add_where('name',      'fred');
        $sql->add_where('bucket_id', { op => '!=', value => 47 });
        $sql->add_where('note_id',   \'IS NULL');
        $sql->limit(1);
    
        my $sth = $dbh->prepare($sql->as_sql);
        $sth->execute(@{ $sql->{bind} });
        my @values = $sth->selectrow_array();
    
        my $obj = SomeObject->new();
        $obj->set_columns(...);

DESCRIPTION

    AlignDB::SQL represents an SQL statement.

    Most codes come from Data::ObjectDriver::SQL

lib/AlignDB/SQL.pm  view on Meta::CPAN

with Storage( 'format' => 'YAML' );

our $VERSION = '1.0.2';

has 'select'             => ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );
has 'select_map'         => ( is => 'rw', isa => 'HashRef',  default => sub { {} } );
has 'select_map_reverse' => ( is => 'rw', isa => 'HashRef',  default => sub { {} } );
has 'from'               => ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );
has 'joins'              => ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );
has 'where'              => ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );
has 'bind'               => ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );
has 'limit'              => ( is => 'rw', isa => 'Int' );
has 'offset'             => ( is => 'rw', );
has 'group'              => ( is => 'rw', );
has 'order'              => ( is => 'rw', );
has 'having'             => ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );
has 'where_values'       => ( is => 'rw', isa => 'HashRef',  default => sub { {} } );
has '_sql'    => ( is => 'rw', isa => 'Str',     default => '' );
has 'indent'  => ( is => 'rw', isa => 'Str',     default => ' ' x 2 );
has 'replace' => ( is => 'rw', isa => 'HashRef', default => sub { {} } );

lib/AlignDB/SQL.pm  view on Meta::CPAN

        ? 'HAVING ' . join( "\n$indent" . "AND ", @{ $self->having } ) . "\n"
        : '';
}

sub add_where {
    my $self = shift;
    ## xxx Need to support old range and transform behaviors.
    my ( $col, $val ) = @_;

    #croak("Invalid/unsafe column name $col") unless $col =~ /^[\w\.]+$/;
    my ( $term, $bind ) = $self->_mk_term( $col, $val );
    push @{ $self->{where} }, "($term)";
    push @{ $self->{bind} },  @$bind;
    $self->where_values->{$col} = $val;
}

sub has_where {
    my $self = shift;
    my ( $col, $val ) = @_;

    # TODO: should check if the value is same with $val?
    exists $self->where_values->{$col};
}

sub add_having {
    my $self = shift;
    my ( $col, $val ) = @_;

    if ( my $orig = $self->select_map_reverse->{$col} ) {
        $col = $orig;
    }

    my ( $term, $bind ) = $self->_mk_term( $col, $val );
    push @{ $self->{having} }, "($term)";
    push @{ $self->{bind} },   @$bind;
}

#@returns AlignDB::SQL
sub copy {
    my $self = shift;
    my $copy = __PACKAGE__->thaw( $self->freeze );
    return $copy;
}

sub _mk_term {
    my $self = shift;
    my ( $col, $val ) = @_;
    my $term = '';
    my @bind;
    if ( ref($val) eq 'ARRAY' ) {
        if ( ref $val->[0] or $val->[0] eq '-and' ) {
            my $logic  = 'OR';
            my @values = @$val;
            if ( $val->[0] eq '-and' ) {
                $logic = 'AND';
                shift @values;
            }

            my @terms;
            for my $v (@values) {
                my ( $term, $bind ) = $self->_mk_term( $col, $v );
                push @terms, "($term)";
                push @bind,  @$bind;
            }
            $term = join " $logic ", @terms;
        }
        else {
            $term = "$col IN (" . join( ',', ('?') x scalar @$val ) . ')';
            @bind = @$val;
        }
    }
    elsif ( ref($val) eq 'HASH' ) {
        my $c = $val->{column} || $col;
        $term = "$c $val->{op} ?";
        push @bind, $val->{value};
    }
    elsif ( ref($val) eq 'SCALAR' ) {
        $term = "$col $$val";
    }
    else {
        $term = "$col = ?";
        push @bind, $val;
    }

    return ( $term, \@bind );
}

1;

__END__

=pod

=encoding UTF-8

lib/AlignDB/SQL.pm  view on Meta::CPAN

    my $sql = AlignDB::SQL->new();
    $sql->select([ 'id', 'name', 'bucket_id', 'note_id' ]);
    $sql->from([ 'foo' ]);
    $sql->add_where('name',      'fred');
    $sql->add_where('bucket_id', { op => '!=', value => 47 });
    $sql->add_where('note_id',   \'IS NULL');
    $sql->limit(1);

    my $sth = $dbh->prepare($sql->as_sql);
    $sth->execute(@{ $sql->{bind} });
    my @values = $sth->selectrow_array();

    my $obj = SomeObject->new();
    $obj->set_columns(...);

=head1 DESCRIPTION

I<AlignDB::SQL> represents an SQL statement.

Most codes come from Data::ObjectDriver::SQL

t/01.sql.t  view on Meta::CPAN

{    ## Non-numerics should cause an error
    my $sql = eval { $stmt->limit("  15g"); strip( $stmt->as_sql ) };
    like $@, qr/Int/, "bogus limit causes as_sql assertion";
}

## Testing WHERE
$stmt = ns();
$stmt->add_where( foo => 'bar' );
is( strip( $stmt->as_sql_where ), "WHERE (foo = ?)" );
is( scalar @{ $stmt->bind },      1 );
is( $stmt->bind->[0],             'bar' );

$stmt = ns();
$stmt->add_where( foo => [ 'bar', 'baz' ] );
is( strip( $stmt->as_sql_where ), "WHERE (foo IN (?,?))" );
is( scalar @{ $stmt->bind },      2 );
is( $stmt->bind->[0],             'bar' );
is( $stmt->bind->[1],             'baz' );

$stmt = ns();
$stmt->add_where( foo => { op => '!=', value => 'bar' } );
is( strip( $stmt->as_sql_where ), "WHERE (foo != ?)" );
is( scalar @{ $stmt->bind },      1 );
is( $stmt->bind->[0],             'bar' );

$stmt = ns();
$stmt->add_where( foo => { column => 'bar', op => '!=', value => 'bar' } );
is( strip( $stmt->as_sql_where ), "WHERE (bar != ?)" );
is( scalar @{ $stmt->bind },      1 );
is( $stmt->bind->[0],             'bar' );

$stmt = ns();
$stmt->add_where( foo => \'IS NOT NULL' );
is( strip( $stmt->as_sql_where ), "WHERE (foo IS NOT NULL)" );
is( scalar @{ $stmt->bind },      0 );

$stmt = ns();
$stmt->add_where( foo => 'bar' );
$stmt->add_where( baz => 'quux' );
is( strip( $stmt->as_sql_where ), "WHERE (foo = ?) AND (baz = ?)" );
is( scalar @{ $stmt->bind },      2 );
is( $stmt->bind->[0],             'bar' );
is( $stmt->bind->[1],             'quux' );

$stmt = ns();
$stmt->add_where(
    foo => [ { op => '>', value => 'bar' }, { op => '<', value => 'baz' } ] );
is( strip( $stmt->as_sql_where ), "WHERE ((foo > ?) OR (foo < ?))" );
is( scalar @{ $stmt->bind },      2 );
is( $stmt->bind->[0],             'bar' );
is( $stmt->bind->[1],             'baz' );

$stmt = ns();
$stmt->add_where(
    foo => [
        -and => { op => '>', value => 'bar' },
        { op => '<', value => 'baz' }
    ]
);
is( strip( $stmt->as_sql_where ), "WHERE ((foo > ?) AND (foo < ?))" );
is( scalar @{ $stmt->bind },      2 );
is( $stmt->bind->[0],             'bar' );
is( $stmt->bind->[1],             'baz' );

$stmt = ns();
$stmt->add_where( foo => [ -and => 'foo', 'bar', 'baz' ] );
is( strip( $stmt->as_sql_where ),
    "WHERE ((foo = ?) AND (foo = ?) AND (foo = ?))" );
is( scalar @{ $stmt->bind }, 3 );
is( $stmt->bind->[0],        'foo' );
is( $stmt->bind->[1],        'bar' );
is( $stmt->bind->[2],        'baz' );

## regression bug. modified parameters
my %terms = ( foo => [ -and => 'foo', 'bar', 'baz' ] );
$stmt = ns();
$stmt->add_where(%terms);
is( strip( $stmt->as_sql_where ),
    "WHERE ((foo = ?) AND (foo = ?) AND (foo = ?))" );
$stmt->add_where(%terms);
is( strip( $stmt->as_sql_where ),
    "WHERE ((foo = ?) AND (foo = ?) AND (foo = ?)) AND ((foo = ?) AND (foo = ?) AND (foo = ?))"

t/03.where.t  view on Meta::CPAN

$stmt->add_where(
    foo => [
        -and => { op => '>', value => 'bar' },
        { op => '<', value => 'baz' }
    ]
);
print $stmt->as_sql;

#$stmt = ns();
#is( $stmt->as_sql_where,     "WHERE ((foo > ?) AND (foo < ?))\n" );
#is( scalar @{ $stmt->bind }, 2 );
#is( $stmt->bind->[0],        'bar' );
#is( $stmt->bind->[1],        'baz' );
#
#$stmt = ns();
#$stmt->add_where( foo => [ -and => 'foo', 'bar', 'baz' ] );
#is( $stmt->as_sql_where, "WHERE ((foo = ?) AND (foo = ?) AND (foo = ?))\n" );
#is( scalar @{ $stmt->bind }, 3 );
#is( $stmt->bind->[0],        'foo' );
#is( $stmt->bind->[1],        'bar' );
#is( $stmt->bind->[2],        'baz' );
#
## regression bug. modified parameters
my %terms = ( foo => [ -and => 'foo', 'bar', 'baz' ] );
$stmt = ns();
$stmt->add_where(%terms);
is strip( $stmt->as_sql_where ),
    "WHERE ((foo = ?) AND (foo = ?) AND (foo = ?))";
$stmt->add_where(%terms);
is strip( $stmt->as_sql_where ),
    "WHERE ((foo = ?) AND (foo = ?) AND (foo = ?)) AND ((foo = ?) AND (foo = ?) AND (foo = ?))";