Alzabo
view release on metacpan or search on metacpan
lib/Alzabo/SQLMaker.pm view on Meta::CPAN
package Alzabo::SQLMaker;
use strict;
use vars qw($VERSION $AUTOLOAD);
use Alzabo::Exceptions;
use Alzabo::Utils;
use Class::Factory::Util;
use Params::Validate qw( :all );
Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } );
$VERSION = 2.0;
1;
sub make_function
{
my $class = caller;
my %p =
validate( @_,
{ function => { type => SCALAR },
min => { type => SCALAR, optional => 1 },
max => { type => UNDEF | SCALAR, optional => 1 },
groups => { type => ARRAYREF },
quote => { type => ARRAYREF, optional => 1 },
format => { type => SCALAR, optional => 1 },
is_modifier => { type => SCALAR, default => 0 },
has_spaces => { type => SCALAR, default => 0 },
allows_alias => { type => SCALAR, default => 1 },
no_parens => { type => SCALAR, default => 0 },
} );
my $valid = '';
if ( $p{min} || $p{max} )
{
$valid .= 'validate_pos( @_, ';
$valid .= join ', ', ('1') x $p{min};
}
if ( defined $p{min} && defined $p{max} && $p{max} > $p{min} )
{
$valid .= ', ';
$valid .= join ', ', ('0') x ( $p{max} - $p{min} );
}
elsif ( exists $p{min} && ! defined $p{max} )
{
$valid .= ", ('1') x (\@_ - $p{min})";
}
$valid .= ' );' if $valid;
my @args = "function => '$p{function}'";
if ( ! defined $p{max} || $p{max} > 0 )
{
push @args, ' args => [@_]';
}
if ( $p{format} )
{
push @args, " format => '$p{format}'";
}
if ( $p{quote} )
{
my $quote .= ' quote => [';
$quote .= join ', ', @{ $p{quote} };
$quote .= ']';
push @args, $quote;
}
for my $k ( qw( is_modifier has_spaces allows_alias no_parens ) )
{
if ( $p{$k} )
{
push @args, " $k => 1";
}
}
my $args = join ",\n", @args;
my $code = <<"EOF";
sub ${class}::$p{function}
{
shift if defined \$_[0] && Alzabo::Utils::safe_isa( \$_[0], 'Alzabo::SQLMaker' );
$valid
return Alzabo::SQLMaker::Function->new( $args );
}
EOF
eval $code;
{
no strict 'refs';
push @{ "$class\::EXPORT_OK" }, $p{function};
my $exp = \%{ "$class\::EXPORT_TAGS" };
foreach ( @{ $p{groups} } )
{
push @{ $exp->{$_} }, $p{function};
}
push @{ $exp->{all} }, $p{function};
}
}
sub load
{
shift;
my %p = @_;
my $class = "Alzabo::SQLMaker::$p{rdbms}";
eval "use $class";
Alzabo::Exception::Eval->throw( error => $@ ) if $@;
$class->init(@_);
return $class;
}
sub available { __PACKAGE__->subclasses }
sub init
{
1;
}
use constant NEW_SPEC => { driver => { isa => 'Alzabo::Driver' },
quote_identifiers => { type => BOOLEAN,
default => 0 },
};
sub new
{
my $class = shift;
my %p = validate( @_, NEW_SPEC );
return bless { last_op => undef,
expect => undef,
type => undef,
sql => '',
bind => [],
placeholders => [],
as_id => 'aaaaa10000',
alias_in_having => 1,
%p,
}, $class;
}
# this just needs to be some unique thing that won't ever look like a
# valid bound parameter
my $placeholder = do { my $x = 1; bless \$x, 'Alzabo::SQLMaker::Placeholder' };
sub placeholder { $placeholder }
sub last_op
{
return shift->{last_op};
}
sub select
{
my $self = shift;
Alzabo::Exception::Params->throw( error => "The select method requires at least one parameter" )
unless @_;
$self->{sql} .= 'SELECT ';
if ( lc $_[0] eq 'distinct' )
{
$self->{sql} .= ' DISTINCT ';
shift;
}
my @sql;
foreach my $elt (@_)
{
if ( Alzabo::Utils::safe_can( $elt, 'table' ) )
{
my $table = $elt->table;
$self->{column_tables}{"$table"} = 1;
my $sql =
( $self->{quote_identifiers} ?
$self->{driver}->quote_identifier
( $table->alias_name, $elt->name ) :
$table->alias_name . '.' . $elt->name );
$sql .= ' AS ' .
( $self->{quote_identifiers} ?
$self->{driver}->quote_identifier( $elt->alias_name ) :
$elt->alias_name );
push @sql, $sql;
}
lib/Alzabo/SQLMaker.pm view on Meta::CPAN
my $sql =
( $self->{quote_identifiers} ?
$self->{driver}->quote_identifier
( $elt->alias_name, $col->name ) :
$elt->alias_name . '.' . $col->name );
$sql .= ' AS ' .
( $self->{quote_identifiers} ?
$self->{driver}->quote_identifier( $elt->alias_name ) :
$elt->alias_name );
push @cols, $sql;
}
push @sql, join ', ', @cols;
}
elsif ( Alzabo::Utils::safe_isa( $elt, 'Alzabo::SQLMaker::Function' ) )
{
my $string = $elt->as_string( $self->{driver}, $self->{quote_identifiers} );
if ( $elt->allows_alias )
{
push @sql, " $string AS " . $self->{as_id};
$self->{functions}{$string} = $self->{as_id};
++$self->{as_id};
}
else
{
push @sql, $string;
}
}
elsif ( ! ref $elt )
{
push @sql, $elt;
}
else
{
Alzabo::Exception::SQL->throw
( error => 'Arguments to select must be either column objects,' .
' table objects, function objects, or plain scalars' );
}
}
$self->{sql} .= join ', ', @sql;
$self->{type} = 'select';
$self->{last_op} = 'select';
return $self;
}
sub from
{
my $self = shift;
$self->_assert_last_op( qw( select delete function ) );
my $spec =
$self->{last_op} eq 'select' ? { type => OBJECT | ARRAYREF } : { can => 'alias_name' };
validate_pos( @_, ( $spec ) x @_ );
$self->{sql} .= ' FROM ';
if ( $self->{last_op} eq 'delete' )
{
$self->{sql} .=
join ', ', map { ( $self->{quote_identifiers} ?
$self->{driver}->quote_identifier( $_->name ) :
$_->name ) } @_;
$self->{tables} = { map { $_ => 1 } @_ };
}
else
{
my $sql;
$self->{tables} = {};
my @plain;
foreach my $elt (@_)
{
if ( Alzabo::Utils::is_arrayref($elt) )
{
$sql .= ' ' if $sql;
$sql .= $self->_outer_join(@$elt);
}
else
{
push @plain, $elt;
}
}
foreach my $elt ( grep { ! exists $self->{tables}{$_ } } @plain )
{
$sql .= ', ' if $sql;
if ( $self->{quote_identifiers} )
{
$sql .=
( $self->{driver}->quote_identifier( $elt->name ) .
' AS ' .
$self->{driver}->quote_identifier( $elt->alias_name ) );
}
else
{
$sql .= $elt->name . ' AS ' . $elt->alias_name;
}
$self->{tables}{$elt} = 1;
}
$self->{sql} .= $sql;
}
if ($self->{type} eq 'select')
{
foreach my $t ( keys %{ $self->{column_tables} } )
{
unless ( $self->{tables}{$t} )
{
my $err = 'Cannot select column ';
$err .= 'unless its table is included in the FROM clause';
Alzabo::Exception::SQL->throw( error => $err );
}
}
}
$self->{last_op} = 'from';
return $self;
}
use constant _OUTER_JOIN_SPEC => ( { type => SCALAR },
( { can => 'alias_name' } ) x 2,
{ type => UNDEF | ARRAYREF | OBJECT, optional => 1 },
{ type => UNDEF | ARRAYREF, optional => 1 },
);
sub _outer_join
{
my $self = shift;
my $tables = @_ - 1;
validate_pos( @_, _OUTER_JOIN_SPEC );
my $type = uc shift;
my $join_from = shift;
my $join_on = shift;
my $fk;
$fk = shift if $_[0] && Alzabo::Utils::safe_isa( $_[0], 'Alzabo::ForeignKey' );
my $where = shift;
unless ($fk)
{
my @fk = $join_from->foreign_keys_by_table($join_on);
Alzabo::Exception::Params->throw( error => "The " . $join_from->name . " table has no foreign keys to the " . $join_on->name . " table" )
unless @fk;
Alzabo::Exception::Params->throw( error => "The " . $join_from->name . " table has more than 1 foreign key to the " . $join_on->name . " table" )
if @fk > 1;
$fk = $fk[0];
}
my $sql;
unless ( $self->{tables}{$join_from} )
{
$sql .=
( $self->{quote_identifiers} ?
$self->{driver}->quote_identifier( $join_from->name ) :
$join_from->name );
$sql .= ' AS ';
$sql .=
( $self->{quote_identifiers} ?
$self->{driver}->quote_identifier( $join_from->alias_name ) :
$join_from->alias_name );
}
$sql .= " $type OUTER JOIN ";
$sql .= ( $self->{quote_identifiers} ?
$self->{driver}->quote_identifier( $join_on->name ) :
$join_on->name );
$sql .= ' AS ';
$sql .=
( $self->{quote_identifiers} ?
$self->{driver}->quote_identifier( $join_on->alias_name ) :
$join_on->alias_name );
$sql .= ' ON ';
if ( $self->{quote_identifiers} )
{
$sql .=
( join ' AND ',
map { $self->{driver}->quote_identifier
( $join_from->alias_name, $_->[0]->name ) .
' = ' .
$self->{driver}->quote_identifier
lib/Alzabo/SQLMaker.pm view on Meta::CPAN
sub or
{
my $self = shift;
$self->_assert_last_op( qw( subgroup_end condition ) );
return $self->_and_or( 'or', @_ );
}
sub _and_or
{
my $self = shift;
my $op = shift;
$self->{sql} .= " \U$op ";
$self->{last_op} = $op;
$self->condition(@_) if @_;
return $self;
}
sub subgroup_start
{
my $self = shift;
$self->_assert_last_op( qw( where having and or subgroup_start ) );
$self->{sql} .= ' (';
$self->{subgroup} ||= 0;
$self->{subgroup}++;
$self->{last_op} = 'subgroup_start';
return $self;
}
sub subgroup_end
{
my $self = shift;
$self->_assert_last_op( qw( condition subgroup_end ) );
Alzabo::Exception::SQL->throw( error => "Can't end a subgroup unless one has been started already" )
unless $self->{subgroup};
$self->{sql} .= ' )';
$self->{subgroup}--;
$self->{last_op} = $self->{subgroup} ? 'subgroup_end' : 'condition';
return $self;
}
sub condition
{
my $self = shift;
validate_pos( @_,
{ type => OBJECT },
{ type => SCALAR },
{ type => UNDEF | SCALAR | OBJECT },
( { type => UNDEF | SCALAR | OBJECT, optional => 1 } ) x (@_ - 3) );
my $lhs = shift;
my $comp = uc shift;
my $rhs = shift;
my $in_having = $self->{last_op} eq 'having' ? 1 : 0;
$self->{last_op} = 'condition';
if ( $lhs->can('table') && $lhs->can('name') )
{
unless ( $self->{tables}{ $lhs->table } )
{
my $err = 'Cannot use column (';
$err .= join '.', $lhs->table->name, $lhs->name;
$err .= ") in $self->{type} unless its table is included in the ";
$err .= $self->{type} eq 'update' ? 'UPDATE' : 'FROM';
$err .= ' clause';
Alzabo::Exception::SQL->throw( error => $err );
}
$self->{sql} .=
( $self->{quote_identifiers} ?
$self->{driver}->quote_identifier( $lhs->table->alias_name, $lhs->name ) :
$lhs->table->alias_name . '.' . $lhs->name );
}
elsif ( $lhs->isa('Alzabo::SQLMaker::Function') )
{
my $string = $lhs->as_string( $self->{driver}, $self->{quote_identifiers} );
if ( exists $self->{functions}{$string} &&
( ! $in_having || $self->{alias_in_having} ) )
{
$self->{sql} .= $self->{functions}{$string};
}
else
{
$self->{sql} .= $string;
}
}
else
{
Alzabo::Exception::SQL->throw
( error => "Cannot use " . (ref $lhs) . " object as part of condition" );
}
if ( $comp eq 'BETWEEN' )
{
Alzabo::Exception::SQL->throw
( error => "The BETWEEN comparison operator requires an additional argument" )
unless @_ == 1;
my $rhs2 = shift;
Alzabo::Exception::SQL->throw
( error => "The BETWEEN comparison operator cannot accept a subselect" )
lib/Alzabo/SQLMaker.pm view on Meta::CPAN
if( $rhs->isa('Alzabo::SQLMaker') )
{
$self->{sql} .= '(';
$self->{sql} .= $self->_subselect($rhs);
$self->{sql} .= ')';
}
else
{
$self->{sql} .= $self->_rhs($rhs);
}
}
}
sub _rhs
{
my $self = shift;
my $rhs = shift;
if ( Alzabo::Utils::safe_can( $rhs, 'table' ) )
{
unless ( $self->{tables}{ $rhs->table } )
{
my $err = 'Cannot use column (';
$err .= join '.', $rhs->table->name, $rhs->name;
$err .= ") in $self->{type} unless its table is included in the ";
$err .= $self->{type} eq 'update' ? 'UPDATE' : 'FROM';
$err .= ' clause';
Alzabo::Exception::SQL->throw( error => $err );
}
return ( $self->{quote_identifiers} ?
$self->{driver}->quote_identifier( $rhs->table->alias_name, $rhs->name ) :
$rhs->table->alias_name . '.' . $rhs->name );
}
else
{
return $self->_bind_val($rhs);
}
}
sub _subselect
{
my $self = shift;
my $sql = shift;
push @{ $self->{bind} }, @{ $sql->bind };
return $sql->sql;
}
sub order_by
{
my $self = shift;
$self->_assert_last_op( qw( select from condition group_by ) );
Alzabo::Exception::SQL->throw
( error => "Cannot use order by in a '$self->{type}' statement" )
unless $self->{type} eq 'select';
validate_pos( @_, ( { type => SCALAR | OBJECT,
callbacks =>
{ 'column_or_function_or_sort' =>
sub { Alzabo::Utils::safe_can( $_[0], 'table' ) ||
Alzabo::Utils::safe_isa( $_[0], 'Alzabo::SQLMaker::Function' ) ||
$_[0] =~ /^(?:ASC|DESC)$/i } } }
) x @_ );
$self->{sql} .= ' ORDER BY ';
my $x = 0;
my $last = '';
foreach my $i (@_)
{
if ( Alzabo::Utils::safe_can( $i, 'table' ) )
{
unless ( $self->{tables}{ $i->table } )
{
my $err = 'Cannot use column (';
$err .= join '.', $i->table->name, $i->name;
$err .= ") in $self->{type} unless its table is included in the FROM clause";
Alzabo::Exception::SQL->throw( error => $err );
}
# no comma needed for first column
$self->{sql} .= ', ', if $x++;
$self->{sql} .=
( $self->{quote_identifiers} ?
$self->{driver}->quote_identifier( $i->table->alias_name, $i->alias_name ) :
$i->table->alias_name . '.' . $i->alias_name );
$last = 'column';
}
elsif ( Alzabo::Utils::safe_isa( $i, 'Alzabo::SQLMaker::Function' ) )
{
my $string = $i->as_string( $self->{driver}, $self->{quote_identifiers} );
if ( exists $self->{functions}{$string} )
{
$self->{sql} .= ', ', if $x++;
$self->{sql} .= $self->{functions}{$string};
}
else
{
$self->{sql} .= ', ', if $x++;
$self->{sql} .= $string;
}
$last = 'function';
}
else
{
Alzabo::Exception::Params->throw
( error => 'A sort specifier cannot follow another sort specifier in an ORDER BY clause' )
if $last eq 'sort';
$self->{sql} .= " \U$i";
$last = 'sort';
}
}
$self->{last_op} = 'order_by';
return $self;
}
sub group_by
{
my $self = shift;
$self->_assert_last_op( qw( select from condition ) );
Alzabo::Exception::SQL->throw
( error => "Cannot use group by in a '$self->{type}' statement" )
unless $self->{type} eq 'select';
validate_pos( @_, ( { can => 'table' } ) x @_ );
foreach my $c (@_)
{
unless ( $self->{tables}{ $c->table } )
{
my $err = 'Cannot use column (';
$err .= join '.', $c->table->name, $c->name;
$err .= ") in $self->{type} unless its table is included in the FROM clause";
Alzabo::Exception::SQL->throw( error => $err );
}
}
$self->{sql} .= ' GROUP BY ';
$self->{sql} .=
( join ', ',
map { ( $self->{quote_identifiers} ?
$self->{driver}->quote_identifier( $_->table->alias_name, $_->alias_name ) :
$_->table->alias_name . '.' . $_->alias_name ) }
@_ );
$self->{last_op} = 'group_by';
return $self;
}
sub insert
{
my $self = shift;
$self->{sql} .= 'INSERT ';
$self->{type} = 'insert';
$self->{last_op} = 'insert';
return $self;
}
sub into
{
my $self = shift;
$self->_assert_last_op( qw( insert ) );
validate_pos( @_, { can => 'alias_name' }, ( { can => 'table' } ) x (@_ - 1) );
my $table = shift;
$self->{tables} = { $table => 1 };
foreach my $c (@_)
{
unless ( $c->table eq $table )
{
my $err = 'Cannot into column (';
$err .= join '.', $c->table->name, $c->name;
$err .= ') because its table was not the one specified in the INTO clause';
Alzabo::Exception::SQL->throw( error => $err );
}
}
$self->{columns} = [ @_ ? @_ : $table->columns ];
$self->{sql} .= 'INTO ';
$self->{sql} .= ( $self->{quote_identifiers} ?
$self->{driver}->quote_identifier( $table->name ) :
$table->name );
$self->{sql} .= ' (';
$self->{sql} .=
( join ', ',
map { ( $self->{quote_identifiers} ?
$self->{driver}->quote_identifier( $_->name ) :
$_->name ) }
@{ $self->{columns} } );
$self->{sql} .= ') ';
$self->{last_op} = 'into';
return $self;
}
sub values
{
my $self = shift;
$self->_assert_last_op( qw( into ) );
validate_pos( @_, ( { type => UNDEF | SCALAR | OBJECT } ) x @_ );
if ( ref $_[0] && $_[0]->isa('Alzabo::SQLMaker') )
{
$self->{sql} = $_[0]->sql;
push @{ $self->{bind} }, $_[0]->bind;
}
else
{
my @vals = @_;
Alzabo::Exception::Params->throw
( error => "'values' method expects key/value pairs of column objects and values'" )
if !@vals || @vals % 2;
my %vals = map { ref $_ && $_->can('table') ? $_->name : $_ } @vals;
foreach my $c ( @vals[ map { $_ * 2 } 0 .. int($#vals/2) ] )
{
Alzabo::Exception::SQL->throw
( error => $c->name . " column was not specified in the into method call" )
unless grep { $c eq $_ } @{ $self->{columns} };
}
foreach my $c ( @{ $self->{columns } } )
{
Alzabo::Exception::SQL->throw
( error => $c->name . " was specified in the into method call but no value was provided" )
unless exists $vals{ $c->name };
}
$self->{sql} .= 'VALUES (';
$self->{sql} .=
join ', ', ( map { $self->_bind_val_for_insert( $_, $vals{ $_->name } ) }
@{ $self->{columns} }
);
$self->{sql} .= ')';
}
if ( @{ $self->{placeholders} } && @{ $self->{bind} } )
{
Alzabo::Exception::SQL->throw
( error => "Cannot mix actual bound values and placeholders in call to values()" );
}
$self->{last_op} = 'values';
return $self;
}
use constant UPDATE_SPEC => { can => 'alias_name' };
sub update
{
my $self = shift;
validate_pos( @_, UPDATE_SPEC );
my $table = shift;
$self->{sql} = 'UPDATE ';
$self->{sql} .= ( $self->{quote_identifiers} ?
$self->{driver}->quote_identifier( $table->name ) :
$table->name );
$self->{tables} = { $table => 1 };
$self->{type} = 'update';
$self->{last_op} = 'update';
return $self;
}
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 );
}
( run in 0.693 second using v1.01-cache-2.11-cpan-39bf76dae61 )