package Fey::SQL::Update; use strict; use warnings; our $VERSION = '0.34'; use Fey::Exceptions qw( param_error ); use Fey::Literal; use Fey::Types; use overload (); use Scalar::Util qw( blessed ); use Moose; use MooseX::Params::Validate qw( pos_validated_list ); use MooseX::SemiAffordanceAccessor; use MooseX::StrictConstructor; with 'Fey::Role::SQL::HasOrderByClause', 'Fey::Role::SQL::HasLimitClause'; with 'Fey::Role::SQL::HasWhereClause' => { excludes => 'bind_params', alias => { bind_params => '_where_clause_bind_params' }, }; with 'Fey::Role::SQL::HasBindParams' => { excludes => 'bind_params', alias => { bind_params => '_update_bind_params' }, }; has '_update' => ( is => 'rw', isa => 'ArrayRef', default => sub { [] }, init_arg => undef, ); has '_set_pairs' => ( traits => [ 'Array' ], is => 'bare', isa => 'ArrayRef[ArrayRef]', default => sub { [] }, handles => { _add_set_pair => 'push', _set_pairs => 'elements', }, init_arg => undef, ); with 'Fey::Role::SQL::Cloneable'; sub update { my $self = shift; my $count = @_ ? @_ : 1; my (@tables) = pos_validated_list( \@_, ( ( { isa => 'Fey::Table' } ) x $count ), MX_PARAMS_VALIDATE_NO_CACHE => 1, ); $self->_set_update(\@tables); return $self; } sub set { my $self = shift; if ( ! @_ || @_ % 2 ) { my $count = @_; param_error "The set method expects a list of paired column objects and values but you passed $count parameters"; } my @spec; for ( my $x = 0; $x < @_; $x += 2 ) { push @spec, { isa => 'Fey::Types::ColumnWithTable' }; push @spec, blessed $_[$x] && $_[$x]->is_nullable() ? { isa => 'Fey::Types::NullableUpdateValue' } : { isa => 'Fey::Types::NonNullableUpdateValue' }; } my @set = pos_validated_list( \@_, @spec, MX_PARAMS_VALIDATE_NO_CACHE => 1 ); for ( my $x = 0; $x < @_; $x += 2 ) { my $val = $_[ $x + 1 ]; $val .= '' if blessed $val && overload::Overloaded($val); if ( ! blessed $val ) { if ( defined $val && $self->auto_placeholders() ) { $self->_add_bind_param($val); $val = Fey::Placeholder->new(); } else { $val = Fey::Literal->new_from_scalar($val ); } } $self->_add_set_pair( [ $_[$x], $val ] ); } return $self; } sub sql { my $self = shift; my ($dbh) = pos_validated_list( \@_, { isa => 'Fey::Types::CanQuote' } ); return ( join ' ', $self->update_clause($dbh), $self->set_clause($dbh), $self->where_clause($dbh), $self->order_by_clause($dbh), $self->limit_clause($dbh), ); } sub update_clause { return 'UPDATE ' . $_[0]->_tables_subclause( $_[1] ); } sub _tables_subclause { return ( join ', ', map { $_[1]->quote_identifier( $_->name() ) } @{ $_[0]->_update() } ); } sub set_clause { my $self = shift; my $dbh = shift; # SQLite objects when the table name is provided ("User"."email") # on the LHS of the set. I'm hoping that a DBMS which allows a # multi-table update also allows the table name in the LHS. my $col_quote = @{ $self->_update() } > 1 ? '_name_and_table' : '_name'; return ( 'SET ' . ( join ', ', map { $self->$col_quote( $_->[0], $dbh ) . ' = ' . $_->[1]->sql( $dbh ) } $self->_set_pairs() ) ); } sub _name_and_table { return $_[1]->sql( $_[2] ); } sub _name { return $_[2]->quote_identifier( $_[1]->name() ); } sub bind_params { my $self = shift; return ( $self->_update_bind_params(), $self->_where_clause_bind_params(), ); } no Moose; __PACKAGE__->meta()->make_immutable(); 1; __END__ =head1 NAME Fey::SQL::Update - Represents a UPDATE query =head1 SYNOPSIS my $sql = Fey::SQL->new_update(); # UPDATE Part # SET quantity = 10 # WHERE part_id IN (1, 5) $sql->update($Part); $sql->set( $quantity, 10 ); $sql->where( $part_id, 'IN', 1, 5 ); print $sql->sql($dbh); =head1 DESCRIPTION This class represents a C query. =head1 METHODS This class provides the following methods: =head2 Constructor To construct an object of this class, call C<< $query->update() >> on a C object. =head2 $update->update() This method specifies the C clause of the query. It expects one or more L objects (not aliases). Most RDBMS implementations only allow for a single table here, but some (like MySQL) do allow for multi-table updates. =head2 $update->set(...) This method takes a list of key/value pairs. The keys should be column objects, and the value can be one of the following: =over 4 =item * a plain scalar, including undef This will be passed to C<< Fey::Literal->new_from_scalar() >>. =item * C object =item * C object A column alias cannot be used. =item * C object =back =head2 $update->where(...) See the L for more details. =head2 $update->order_by(...) See the L for more details. =head2 $update->limit(...) See the L for more details. =head2 $update->sql($dbh) Returns the full SQL statement which this object represents. A DBI handle must be passed so that identifiers can be properly quoted. =head2 $update->bind_params() See the L for more details. =head2 $update->update_clause() Returns the C clause portion of the SQL statement as a string. =head2 $update->set_clause() Returns the C clause portion of the SQL statement as a string. =head2 $update->where_clause() Returns the C clause portion of the SQL statement as a string. =head2 $update->order_by_clause() Returns the C clause portion of the SQL statement as a string. =head2 $update->limit_clause() Returns the C clause portion of the SQL statement as a string. =head1 ROLES =over 4 =item * L =item * L =item * L =item * L =item * L =back =head1 AUTHOR Dave Rolsky, =head1 BUGS See L for details on how to report bugs. =head1 COPYRIGHT & LICENSE Copyright 2006-2009 Dave Rolsky, All Rights Reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut