package SimpleDB::Class::SQL;
BEGIN {
  $SimpleDB::Class::SQL::VERSION = '1.0502';
}

=head1 NAME

SimpleDB::Class::SQL - SQL generation tools for SimpleDB.

=head1 VERSION

version 1.0502

=head1 DESCRIPTION

This class is used to generate the SQL needed for the Select operation on SimpleDB's web service.

=head1 METHODS

The following methods are available from this class.

=cut

use Moose;
use JSON;
use DateTime;
use DateTime::Format::Strptime;
use Clone qw(clone);

#--------------------------------------------------------

=head2 new ( params )

Constructor. 

=head3 params

A hash of options you can pass in to the constructor.

=head4 item_class

A L<SimpleDB::Class::Item> subclass name. This is required.

=head4 simpledb

A reference to the L<SimpleDB::Class> object. This is required.

=head4 output

Defaults to '*'. Alternatively you can pass a string of 'count(*)' or an attribute. Or you can pass an array ref of attributes.

=head4 where

A hash reference containing a series of clauses. Here are some examples and what the resulting queries would be. You can of course combine all these options to create your own queries.

B<NOTE:> If you want to search on an item's id (or ItemName) then you should use the C<itemName()> function as the id doesn't actually exist in the item's data.

Direct comparison.

 { foo => 1 }

 select * from domain where foo=1

 { foo => 1, bar => 2 }

 select * from domain where foo=1 and bar=2

 { foo => [ '>', 5 ] } # '=', '!=', '>', '<', '<=', '>='

 select * from domain where foo > 5

Direct comparison with an or clause.

 { -or => {  foo => 1, bar => 2 } }
 
 select * from domain where (foo=1 or bar=2)

Find all items where these attributes intersect.

 { -intersection => {  foo => 1, bar => 2 } }
 
 select * from domain where (foo=1 intersection bar=2)

Combining OR and AND.

 { -or => {  foo => 1, -and => { this => 'that', bar => 2 } }
 
 select * from domain where (foo=1 or ( this='that' and bar=2 ))

Finding within a range.

 { foo=>['between', 5, 10] }

 select * from domain where foo between 5 and 10

Finding within a set.

 { foo => ['in', 1, 3, 5, 7 ] }

 select * from domain where foo in (1, 3, 5, 7)

Finding in a set where every item returned matches all members of the set.

 { foo => ['every', 1, 3, 5, 7 ] }

 select * from domain where every(foo) in (1, 3, 5, 7)

String comparisons. You can match on either side of the string ('%this', 'that%') or both ('%this%'). Note that matching at the beginning or both sides of the string is a slow operation.

 { foo => [ 'like', 'this%' ] } # 'not like'

 select * from domain where foo like 'this%'

Null comparisons. These are very slow. Try inserting 'Null' or 'None' into a field and do string comparisons rather than null comparisons.

 { foo => 'is null' } # 'is not null'

 select * from domain where foo is null

=head4 order_by

An attribute to order the result set by, defaults to ascending order. Can also pass in an array ref containing an attribute and 'desc' or 'asc'. If an array ref is passed in containing only an attribute name it is an implied descending order.

 "foo"

 ["foo","desc"]

 ["foo"]

=head4 limit

An integer of a number of items to limit the result set to.

=cut

#--------------------------------------------------------

=head2 output ()

Returns what was passed into the constructor for the output field.

=cut

has output => (
    is              => 'ro',
    default         => '*',
);

#--------------------------------------------------------

=head2 simpledb ()

Returns the reference passed into the constructor.

=cut

has simpledb => (
    is          => 'ro',
    required    => 1,
);

#--------------------------------------------------------

=head2 item_class ()

Returns what was passed into the constructor for the item_class field.

=cut

has item_class => (
    is              => 'ro',
    required        => 1,
);

#--------------------------------------------------------

=head2 where ()

Returns what was passed into the constructor for the where field.

=head2 has_where()

Returns a boolean indicating whether a where clause has been set.

=cut

has where => (
    is              => 'ro',
    predicate       => 'has_where',
);

#--------------------------------------------------------

=head2 order_by ()

Returns what was passed into the constructor for the output field.

=head2 has_order_by ()

Returns a boolean indicating whether an order by clause has been set.

=cut

has order_by => (
    is              => 'ro',
    predicate       => 'has_order_by',
);

#--------------------------------------------------------

=head2 limit ()

Returns what was passed into the constructor for the output field.

=head2 has_limit ()

=cut

has limit => (
    is              => 'ro',
    predicate       => 'has_limit',
);

#--------------------------------------------------------

=head2 quote_value ( string )

Escapes ' and " in values.  If C<itemName()> is what's passed in, it will not be quoted.


=head3 string

The value to escape.

=cut

sub quote_value {
    my ($self, $string) = @_;
    $string =~ s/'/''/g;
    $string =~ s/"/""/g;
    return "'".$string."'";
}

#--------------------------------------------------------

=head2 quote_attribute ( string )

Escapes an attribute with so that it can contain spaces and other special characters by wrapping it in backticks `. If C<itemName()> is what's passed in, it will not be quoted.

=head3 string

The attribute name to escape.

=cut

sub quote_attribute {
    my ($self, $string) = @_;
    if ($string eq 'itemName()') {
        return $string;
    }
    $string =~ s/`/``/g;
    return "`".$string."`";
}

#--------------------------------------------------------

=head2 recurese_where ( constraints, [ op ] )

Traverses a where() hierarchy and returns a stringified SQL version of the where clause.

=head3 constraints

A portion of a where hierarchy, perhaps broken off from the main for detailed analysis.

=head3 op

If it's a chunk broken off, -and, -or, -intersection then the operator will be passed through here. 

=cut

sub recurse_where {
    my ($self, $constraints, $op) = @_;
    $op ||= ' and ';
    my @sets;
    foreach my $key (keys %{$constraints}) {
        if ($key eq '-and') {
            push @sets, '('.$self->recurse_where($constraints->{$key}, ' and ').')';
        }
        elsif ($key eq '-or') {
            push @sets, '('.$self->recurse_where($constraints->{$key}, ' or ').')';
        }
        elsif ($key eq '-intersection') {
            push @sets, '('.$self->recurse_where($constraints->{$key}, ' intersection ').')';
        }
        else {
            my $value = $constraints->{$key};
            my $item_class = $self->item_class;
            my $attribute = $self->quote_attribute($key);
            if (ref $value eq 'ARRAY') {
                my $cmp = shift @{$value};
                if ($cmp eq '>') {
                    push @sets, $attribute.' > '.$self->quote_value($item_class->stringify_value($key, $value->[0]));
                }
                elsif ($cmp eq '<') {
                    push @sets, $attribute.' < '.$self->quote_value($item_class->stringify_value($key, $value->[0]));
                }
                elsif ($cmp eq '<=') {
                    push @sets, $attribute.' <= '.$self->quote_value($item_class->stringify_value($key, $value->[0]));
                }
                elsif ($cmp eq '>=') {
                    push @sets, $attribute.' >= '.$self->quote_value($item_class->stringify_value($key, $value->[0]));
                }
                elsif ($cmp eq '!=') {
                    push @sets, $attribute.' != '.$self->quote_value($item_class->stringify_value($key, $value->[0]));
                }
                elsif ($cmp eq 'like') {
                    push @sets, $attribute.' like '.$self->quote_value($item_class->stringify_value($key, $value->[0]));
                }
                elsif ($cmp eq 'not like') {
                    push @sets, $attribute.' not like '.$self->quote_value($item_class->stringify_value($key, $value->[0]));
                }
                elsif ($cmp eq 'in') {
                    my @values = map {$self->quote_value($item_class->stringify_value($key, $_))} @{$value};
                    push @sets, $attribute.' in ('.join(', ', @values).')';
                }
                elsif ($cmp eq 'every') {
                    my @values = map {$self->quote_value($item_class->stringify_value($key, $_))} @{$value};
                    push @sets, 'every('.$attribute.') in ('.join(', ', @values).')';
                }
                elsif ($cmp eq 'between') {
                    push @sets, $attribute.' between '.$self->quote_value($item_class->stringify_value($key, $value->[0]))
                        .' and '.$self->quote_value($item_class->stringify_value($key, $value->[1]));
                }
            }
            else {
                my $value = $constraints->{$key};
                if ($value eq 'is null') {
                    push @sets, $attribute.' is null';
                }
                elsif ($value eq 'is not null') {
                    push @sets, $attribute.' is not null';
                }
                else {
                    push @sets, $attribute.' = '.$self->quote_value($item_class->stringify_value($key, $value));
                }
            }
        }
    }
    return join($op, @sets);
}

#--------------------------------------------------------

=head2 to_sql ( ) 

Returns the entire query as a stringified SQL version.

=cut

sub to_sql {
    my ($self) = @_;

    # output
    my $output = $self->output;
    if (ref $output eq 'ARRAY') {
        my @fields = map {$self->quote_attribute($_)} @{$output};
        $output = join ', ', @fields;
    }
    elsif ($output ne '*' && $output ne 'count(*)') {
        $output = $self->quote_attribute($output);
    }

    # where
    my $where='';
    if ($self->has_where) {
        $where = $self->recurse_where(clone($self->where));
        if ($where ne '') {
            $where = ' where '.$where;
        }
    }

    # sort
    my $sort='';
    if ($self->has_order_by) {
        my $by = $self->order_by;
        my $direction = 'asc';
        if (ref $by eq 'ARRAY') {
            ($by, $direction) = @{$by};
            $direction ||= 'desc';
        }
        $sort = ' order by '.$self->quote_attribute($by).' '.$direction;
    }

    # limit
    my $limit='';
    if ($self->has_limit) {
        $limit = ' limit '.$self->limit;
    }

    return 'select '.$output.' from '.$self->quote_attribute($self->simpledb->add_domain_prefix($self->item_class->domain_name)).$where.$sort.$limit;
}


=head1 LEGAL

SimpleDB::Class is Copyright 2009-2010 Plain Black Corporation (L<http://www.plainblack.com/>) and is licensed under the same terms as Perl itself.

=cut

no Moose;
__PACKAGE__->meta->make_immutable;