Data::ObjectDriver::SQL - an SQL statement

Data-ObjectDriver documentation Contained in the Data-ObjectDriver distribution.

Index

Code Index:

NAME

Top

Data::ObjectDriver::SQL - an SQL statement

SYNOPSIS

Top

    my $sql = Data::ObjectDriver::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

Top

Data::ObjectDriver::SQL represents an SQL statement. SQL statements are used internally to Data::ObjectDriver::Driver::DBI object drivers to convert database operations (search(), update(), etc) into database operations, but sometimes you just gotta use SQL.

ATTRIBUTES

Top

Data::ObjectDriver::SQL sports several data attributes that represent the parts of the modeled SQL statement. These attributes all have accessor and mutator methods. Note that some attributes have more convenient methods of modification (for example, add_where() for the where attribute).

select (arrayref)

The database columns to select in a SELECT query.

distinct (boolean)

Whether the SELECT query should return DISTINCT rows only.

select_map (hashref)

The map of database column names to object fields in a SELECT query. Use this mapping to convert members of the select list to column names.

select_map_reverse (hashref)

The map of object fields to database column names in a SELECT query. Use this map to reverse the select_map mapping where needed.

from (arrayref)

The list of tables from which to query results in a SELECT query.

Note if you perform a SELECT query with multiple tables, the rows will be selected as Cartesian products that you'll need to reduce with WHERE clauses. Your query might be better served with real joins specified through the joins attribute of your statement.

joins (arrayref of hashrefs containing scalars and hashrefs)

The list of JOIN clauses to use in the table list of the statement. Each clause is a hashref containing these members:

* table

The name of the table in from being joined.

* joins (arrayref)

The list of joins to perform on the table named in table. Each member of joins is a hashref containing:

* type

The type of join to use. That is, the SQL string to use before the word JOIN in the join expression; for example, INNER or NATURAL RIGHT OUTER). This member is optional. When not specified, the default plain JOIN join is specified.

* table

The name of the table to which to join.

* condition

The SQL expression across which to perform the join, as a string.

where (arrayref)

The list of WHERE clauses that apply to the SQL statement. Individual members of the list are strings of SQL. All members of this attribute must be true for a record to be included as a result; that is, the list members are ANDed together to form the full WHERE clause.

where_values (hashref of variant structures)

The set of data structures used to generate the WHERE clause SQL found in the where attributes, keyed on the associated column names.

bind (arrayref)

The list of values to bind to the query when performed. That is, the list of values to be replaced for the ?es in the SQL.

limit (scalar)

The maximum number of results on which to perform the query.

offset (scalar)

The number of records to skip before performing the query. Combined with a limit and application logic to increase the offset in subsequent queries, you can paginate a set of records with a moving window containing limit records.

group (hashref, or an arrayref of hashrefs)

The fields on which to group the results. Grouping fields are hashrefs containing these members:

* column

Name of the column on which to group.

Note you can set a single grouping field, or use an arrayref containing multiple grouping fields.

having (arrayref)

The list of clauses to specify in the HAVING portion of a GROUP ... HAVING clause. Individual clauses are simple strings containing the conditional expression, as in where.

order (hashref, or an arrayref of hashrefs)

Returns or sets the fields by which to order the results. Ordering fields are hashrefs containing these members:

* column

Name of the column by which to order.

* desc

The SQL keyword to use to specify the ordering. For example, use DESC to specify a descending order. This member is optional.

Note you can set a single ordering field, or use an arrayref containing multiple ordering fields.

$sql->comment([ $comment ])

Returns or sets a simple comment to the SQL statement

USAGE

Top

Data::ObjectDriver::SQL->new()

Creates a new, empty SQL statement.

$sql->add_select($column [, $term ])

Adds the database column $column to the list of fields to return in a SELECT query. The requested object member will be indicated to be $term in the statement's select_map and select_map_reverse attributes.

$term is optional, and defaults to the same value as $column.

$sql->add_join($table, \@joins)

Adds the join statement indicated by $table and \@joins to the list of JOIN table references for the statement. The structure for the set of joins are as described for the joins attribute member above.

$sql->add_index_hint($table, $index)

Specifies a particular index to use for a particular table.

$sql->add_where($column, $value)

Adds a condition on the value of the database column $column to the statement's WHERE clause. A record will be tested against the below conditions according to what type of data structure $value is:

* a scalar

The value of $column must equal $value.

* a reference to a scalar

The value of $column must evaluate true against the SQL given in $$value. For example, if $$value were IS NULL, $column must be NULL for a record to pass.

* a hashref

The value of $column must compare against the condition represented by $value, which can contain the members:

* value

The value with which to compare (required).

* op

The SQL operator with which to compare value and the value of $column (required).

* column

The column name for the comparison. If this is present, it overrides the column name $column, allowing you to build more complex conditions like ((foo = 1 AND bar = 2) OR (baz = 3)).

For example, if value were NULL and op were IS, a record's $column column would have to be NULL to match.

* an arrayref of scalars

The value of $column may equal any of the members of @$value. The generated SQL performs the comparison with as an IN expression.

* an arrayref of (mostly) references

The value of $column must compare against any of the expressions represented in @$value. Each member of the list can be any of the structures described here as possible forms of $value.

If the first member of the @$value array is the scalar string -and, all subsequent members of <@$value> must be met for the record to match. Note this is not very useful unless contained as one option of a larger OR alternation.

All individual conditions specified with add_where() must be true for a record to be a result of the query.

Beware that you can create a circular reference that will recursively generate an infinite SQL statement (for example, by specifying a arrayref $value that itself contains $value). As add_where() evaluates your expressions before storing the conditions in the where attribute as a generated SQL string, this will occur when calling add_where(), not as_sql(). So don't do that.

$sql->add_complex_where(\@list)

This method accepts an array reference of clauses that are glued together with logical operators. With it, you can express where clauses that mix logical operators together to produce more complex queries. For instance:

    [ { foo => 1, bar => 2 }, -or => { baz => 3 } ]

The values given for the columns support all the variants documented for the add_where() method above. Logical operators used inbetween the hashref elements can be one of: '-or', '-and', '-or_not', '-and_not'.

$sql->has_where($column, [$value])

Returns whether a where clause for the column $column was added to the statement with the add_where() method.

The $value argument is currently ignored.

$sql->add_having($column, $value)

Adds an expression to the HAVING portion of the statement's GROUP ... HAVING clause. The expression compares $column using $value, which can be any of the structures described above for the add_where() method.

$sql->add_index_hint($table, \@hints)

Addes the index hint into a SELECT query. The structure for the set of \@hints are arrayref of hashrefs containing these members:

* type (scalar)

The name of the type. "USE", "IGNORE or "FORCE".

* list (arrayref)

The list of name of indexes which to use.

$sql->as_sql()

Returns the SQL fully representing the SQL statement $sql.

$sql->as_sql_having()

Returns the SQL representing the HAVING portion of $sql's GROUP ... HAVING clause.

$sql->as_sql_where()

Returns the SQL representing $sql's WHERE clause.

$sql->as_limit()

Returns the SQL for the LIMIT ... OFFSET clause of the statement.

$sql->as_aggregate($set)

Returns the SQL representing the aggregation clause of type $set for the SQL statement $sql. Reasonable values of $set are ORDER and GROUP.

DIAGNOSTICS

Top

* Invalid/unsafe column name column

The column name you specified to add_where() contained characters that are not allowed in database column names. Only word characters and periods are allowed. Perhaps you didn't filter punctuation out of a generated column name correctly.

BUGS AND LIMITATIONS

Top

Data::ObjectDriver::SQL does not provide the functionality for turning SQL statements into instances of object classes.

SEE ALSO

Top

LICENSE

Top

Data::ObjectDriver is free software; you may redistribute it and/or modify it under the same terms as Perl itself.

AUTHOR & COPYRIGHT

Top

Except where otherwise noted, Data::ObjectDriver is Copyright 2005-2006 Six Apart, cpan@sixapart.com. All rights reserved.

Data-ObjectDriver documentation Contained in the Data-ObjectDriver distribution. 
# $Id$

package Data::ObjectDriver::SQL;
use strict;
use warnings;

use base qw( Class::Accessor::Fast );

__PACKAGE__->mk_accessors(qw(
    select distinct select_map select_map_reverse
    from joins where bind limit offset group order
    having where_values column_mutator index_hint
    comment
));

sub new {
    my $class = shift;
    my $stmt = $class->SUPER::new(@_);
    $stmt->select([]);
    $stmt->distinct(0);
    $stmt->select_map({});
    $stmt->select_map_reverse({});
    $stmt->bind([]);
    $stmt->from([]);
    $stmt->where([]);
    $stmt->where_values({});
    $stmt->having([]);
    $stmt->joins([]);
    $stmt->index_hint({});
    $stmt;
}

sub add_select {
    my $stmt = shift;
    my($term, $col) = @_;
    $col ||= $term;
    push @{ $stmt->select }, $term;
    $stmt->select_map->{$term} = $col;
    $stmt->select_map_reverse->{$col} = $term;
}

sub add_join {
    my $stmt = shift;
    my($table, $joins) = @_;
    push @{ $stmt->joins }, {
        table => $table,
        joins => ref($joins) eq 'ARRAY' ? $joins : [ $joins ],
    };
}

sub add_index_hint {
    my $stmt = shift;
    my($table, $hint) = @_;
    $stmt->index_hint->{$table} = {
        type => $hint->{type} || 'USE',
        list => ref($hint->{list}) eq 'ARRAY' ? $hint->{list} : [ $hint->{list} ],
    };
}

sub as_sql {
    my $stmt = shift;
    my $sql = '';
    if (@{ $stmt->select }) {
        $sql .= 'SELECT ';
        $sql .= 'DISTINCT ' if $stmt->distinct;
        $sql .= join(', ',  map {
            my $alias = $stmt->select_map->{$_};
            $alias && /(?:^|\.)\Q$alias\E$/ ? $_ : "$_ $alias";
        } @{ $stmt->select }) . "\n";
    }
    $sql .= 'FROM ';

    ## Add any explicit JOIN statements before the non-joined tables.
    my %joined;
    my @from = @{ $stmt->from || [] };
    if ($stmt->joins && @{ $stmt->joins }) {
        my $initial_table_written = 0;
        for my $j (@{ $stmt->joins }) {
            my($table, $joins) = map { $j->{$_} } qw( table joins );
            $table = $stmt->_add_index_hint($table); ## index hint handling
            $sql .= $table unless $initial_table_written++;
            $joined{$table}++;
            for my $join (@{ $j->{joins} }) {
                $sql .= ' ' .
                        uc($join->{type}) . ' JOIN ' . $join->{table} . ' ON ' .
                        $join->{condition};
            }
        }
        @from = grep { ! $joined{ $_ } } @from;
        $sql .= ', ' if @from;
    }

    if (@from) {
        $sql .= join ', ', map { $stmt->_add_index_hint($_) } @from;
    }

    $sql .= "\n";
    $sql .= $stmt->as_sql_where;

    $sql .= $stmt->as_aggregate('group');
    $sql .= $stmt->as_sql_having;
    $sql .= $stmt->as_aggregate('order');

    $sql .= $stmt->as_limit;
    my $comment = $stmt->comment;
    if ($comment && $comment =~ /([ 0-9a-zA-Z.:;()_#&,]+)/) {
        $sql .= "-- $1" if $1;
    }
    return $sql;
}

sub as_limit {
    my $stmt = shift;
    my $n = $stmt->limit or
        return '';
    die "Non-numerics in limit clause ($n)" if $n =~ /\D/;
    return sprintf "LIMIT %d%s\n", $n,
           ($stmt->offset ? " OFFSET " . int($stmt->offset) : "");
}

sub as_aggregate {
    my $stmt = shift;
    my($set) = @_;

    if (my $attribute = $stmt->$set()) {
        my $elements = (ref($attribute) eq 'ARRAY') ? $attribute : [ $attribute ];
        return uc($set) . ' BY '
            . join(', ', map { $_->{column} . ($_->{desc} ? (' ' . $_->{desc}) : '') } @$elements)
                . "\n";
    }

    return '';
}

sub as_sql_where {
    my $stmt = shift;
    $stmt->where && @{ $stmt->where } ?
        'WHERE ' . join(' AND ', @{ $stmt->where }) . "\n" :
        '';
}

sub as_sql_having {
    my $stmt = shift;
    $stmt->having && @{ $stmt->having } ?
        'HAVING ' . join(' AND ', @{ $stmt->having }) . "\n" :
        '';
}

sub add_where {
    my $stmt = shift;
    ## xxx Need to support old range and transform behaviors.
    my($col, $val) = @_;
    Carp::croak("Invalid/unsafe column name $col") unless $col =~ /^[\w\.]+$/;
    my($term, $bind, $tcol) = $stmt->_mk_term($col, $val);
    push @{ $stmt->{where} }, "($term)";
    push @{ $stmt->{bind} }, @$bind;
    $stmt->where_values->{$tcol} = $val;
}

sub add_complex_where {
    my $stmt = shift;
    my ($terms) = @_;
    my ($where, $bind) = $stmt->_parse_array_terms($terms);
    push @{ $stmt->{where} }, $where;
    push @{ $stmt->{bind} }, @$bind;
}

sub _parse_array_terms {
    my $stmt = shift;
    my ($term_list) = @_;

    my @out;
    my $logic = 'AND';
    my @bind;
    foreach my $t ( @$term_list ) {
        if (! ref $t ) {
            $logic = $1 if uc($t) =~ m/^-?(OR|AND|OR_NOT|AND_NOT)$/;
            $logic =~ s/_/ /;
            next;
        }
        my $out;
        if (ref $t eq 'HASH') {
            # bag of terms to apply $logic with
            my @out;
            foreach my $t2 ( keys %$t ) {
                my ($term, $bind, $col) = $stmt->_mk_term($t2, $t->{$t2});
                $stmt->where_values->{$col} = $t->{$t2};
                push @out, $term;
                push @bind, @$bind;
            }
            $out .= '(' . join(" AND ", @out) . ")";
        }
        elsif (ref $t eq 'ARRAY') {
            # another array of terms to process!
            my ($where, $bind) = $stmt->_parse_array_terms( $t );
            push @bind, @$bind;
            $out = '(' . $where . ')';
        }
        push @out, (@out ? ' ' . $logic . ' ' : '') . $out;
    }
    return (join("", @out), \@bind);
}

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

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

sub add_having {
    my $stmt = shift;
    my($col, $val) = @_;
#    Carp::croak("Invalid/unsafe column name $col") unless $col =~ /^[\w\.]+$/;

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

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

sub _mk_term {
    my $stmt = shift;
    my($col, $val) = @_;
    my $term = '';
    my (@bind, $m);
    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) = $stmt->_mk_term($col, $v);
                push @terms, "($term)";
                push @bind, @$bind;
            }
            $term = join " $logic ", @terms;
        } else {
            $col = $m->($col) if $m = $stmt->column_mutator;
            $term = "$col IN (".join(',', ('?') x scalar @$val).')';
            @bind = @$val;
        }
    } elsif (ref($val) eq 'HASH') {
        my $c = $val->{column} || $col;
        $c = $m->($c) if $m = $stmt->column_mutator;
        $term = "$c $val->{op} ?";
        push @bind, $val->{value};
    } elsif (ref($val) eq 'SCALAR') {
        $col = $m->($col) if $m = $stmt->column_mutator;
        $term = "$col $$val";
    } else {
        $col = $m->($col) if $m = $stmt->column_mutator;
        $term = "$col = ?";
        push @bind, $val;
    }
    ($term, \@bind, $col);
}

sub _add_index_hint {
    my $stmt = shift;
    my ($tbl_name) = @_;
    my $hint = $stmt->index_hint->{$tbl_name};
    return $tbl_name unless $hint && ref($hint) eq 'HASH';
    if ($hint->{list} && @{ $hint->{list} }) {
        return $tbl_name . ' ' . uc($hint->{type} || 'USE') . ' INDEX (' .
                join (',', @{ $hint->{list} }) .
                ')';
    }
    return $tbl_name;
}

1;

__END__