Alzabo
view release on metacpan or search on metacpan
lib/Alzabo/SQLMaker.pm view on Meta::CPAN
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;
}
elsif ( Alzabo::Utils::safe_can( $elt, 'columns' ) )
{
$self->{column_tables}{"$elt"} = 1;
my @cols;
lib/Alzabo/SQLMaker.pm view on Meta::CPAN
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
( $join_on->alias_name, $_->[1]->name )
} $fk->column_pairs );
}
else
{
$sql .=
( join ' AND ',
map { $join_from->alias_name . '.' . $_->[0]->name .
' = ' .
$join_on->alias_name . '.' . $_->[1]->name
} $fk->column_pairs );
}
@{ $self->{tables} }{ $join_from, $join_on } = (1, 1);
if ($where)
{
$sql .= ' AND ';
# make a clone
my $sql_maker = bless { %$self }, ref $self;
$sql_maker->{sql} = '';
# sharing same ref intentionally
$sql_maker->{bind} = $self->{bind};
$sql_maker->{tables} = $self->{tables};
# lie to Alzabo::Runtime::process_where_clause
$sql_maker->{last_op} = 'where';
Alzabo::Runtime::process_where_clause( $sql_maker, $where );
$sql .= $sql_maker->sql;
$sql .= ' ';
$self->{as_id} = $sql_maker->{as_id};
}
return $sql;
}
sub where
{
my $self = shift;
$self->_assert_last_op( qw( from set ) );
$self->{sql} .= ' WHERE ';
$self->{last_op} = 'where';
$self->condition(@_) if @_;
return $self;
}
sub having
{
my $self = shift;
$self->_assert_last_op( qw( group_by ) );
$self->{sql} .= ' HAVING ';
$self->{last_op} = 'having';
$self->condition(@_) if @_;
return $self;
}
sub and
{
my $self = shift;
$self->_assert_last_op( qw( subgroup_end condition ) );
return $self->_and_or( 'and', @_ );
}
sub or
{
my $self = shift;
lib/Alzabo/SQLMaker.pm view on Meta::CPAN
if ( ! ref $rhs && defined $rhs )
{
$self->{sql} .= " $comp ";
$self->{sql} .= $self->_rhs($rhs);
}
elsif ( ! defined $rhs )
{
if ( $comp eq '=' )
{
$self->{sql} .= ' IS NULL';
}
elsif ( $comp eq '!=' || $comp eq '<>' )
{
$self->{sql} .= ' IS NOT NULL';
}
else
{
Alzabo::Exception::SQL->throw
( error => "Cannot compare a column to a NULL with '$comp'" );
}
}
elsif ( ref $rhs )
{
$self->{sql} .= " $comp ";
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;
}
lib/Alzabo/SQLMaker.pm view on Meta::CPAN
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 );
}
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} } )
{
if ( Alzabo::Utils::safe_can( $self->{args}[$_], 'table' ) )
{
push @args,
( $quote ?
$driver->quote_identifier( $self->{args}[$_]->table->alias_name,
$self->{args}[$_]->name ) :
$self->{args}[$_]->table->alias_name . '.' .
$self->{args}[$_]->name );
next;
}
elsif ( Alzabo::Utils::safe_isa( $self->{args}[$_], 'Alzabo::SQLMaker::Function' ) )
{
push @args, $self->{args}[$_]->as_string( $driver, $quote );
next;
lib/Alzabo/SQLMaker.pm view on Meta::CPAN
=over 4
L<C<values()>|"values (Alzabo::Column object =E<gt> $value, ...)">
=back
Throws: L<C<Alzabo::Exception::SQL>|Alzabo::Exceptions>
=head2 values (C<Alzabo::Column> object => $value, ...)
This method expects to recive an structured like a hash where the keys
are C<Alzabo::Column> objects and the values are the value to be
inserted into that column.
Follows:
=over 4
L<C<into()>|"into (Alzabo::Table object, optional Alzabo::Column objects)">
=back
Throws: L<C<Alzabo::Exception::SQL>|Alzabo::Exceptions>
=head2 set (C<Alzabo::Column> object => $value, ...)
This method'a parameter are exactly like those given to the
L<C<values>|values ( Alzabo::Column object =E<gt> $value, ... )>
method.
Follows:
=over 4
L<C<update()>|"update (Alzabo::Table)">
=back
Followed by:
=over 4
L<C<where()>|"where <see below>">
=back
Throws: L<C<Alzabo::Exception::SQL>|Alzabo::Exceptions>
=head1 RETRIEVING SQL FROM THE OBJECT
=head2 sql
This method can be called at any time, though obviously it will not
return valid SQL unless called at a natural end point. In the future,
an exception may be thrown if called when the SQL is not in a valid
state.
Returns the SQL generated so far as a string.
=head2 bind
Returns an array reference containing the parameters to be bound to
the SQL statement.
=head1 SUBCLASSING Alzabo::SQLMaker
To create a subclass of C<Alzabo::SQLMaker> for your particular RDBMS
requires only that the L<virtual methods|"Virtual Methods"> listed
below be implemented.
In addition, you may choose to override any of the other methods
described in this documentation. For example, the MySQL subclass
override the L<C<_subselect()>|"_subselect"> method because MySQL
cannot support sub-selects.
Subclasses are also expected to offer for export various sets of
functions matching SQL functions. See the C<Alzabo::SQLMaker::MySQL>
subclass implementation for details.
=head1 VIRTUAL METHODS
The following methods must be implemented by the subclass:
=head2 limit
See above for the definition of this method.
=head2 get_limit
This method may return C<undef> even if the L<C<limit()>|"limit ($max,
optional $offset)"> method was called. Some RDBMS's have special SQL
syntax for C<LIMIT> clauses. For those that don't support this, the
L<C<Alzabo::Driver>|Alzabo::Driver> module takes a "limit" parameter.
The return value of this method can be passed in as that parameter.
If the RDBMS does not support C<LIMIT> clauses, the return value is an
array reference containing two values, the maximum number of rows
allowed and the row offset (the first row that should be used).
If the RDBMS does support C<LIMIT> clauses, then the return value is
C<undef>.
=head2 sqlmaker_id
Returns the subclass's name. This should be something that can be
passed to C<< Alzabo::SQLMaker->load() >> as a parameter.
=head1 AUTHOR
Dave Rolsky, <dave@urth.org>
=cut
( run in 0.700 second using v1.01-cache-2.11-cpan-2398b32b56e )