package SQL::Format; use strict; use warnings; use 5.008_001; our $VERSION = '0.04'; use Exporter 'import'; use Carp qw(croak carp); our @EXPORT = qw(sqlf); our $DELIMITER = ', '; our $NAME_SEP = '.'; our $QUOTE_CHAR = '`'; our $LIMIT_DIALECT = 'LimitOffset'; our $SELF = __PACKAGE__->new; my $SPEC_TO_METHOD_MAP = { '%c' => '_columns', '%t' => '_table', '%w' => '_where', '%o' => '_options', '%j' => '_join', '%s' => '_set', }; my $OP_ALIAS = { -IN => 'IN', -NOT_IN => 'NOT IN', -BETWEEN => 'BETWEEN', -NOT_BETWEEN => 'NOT BETWEEN', -LIKE => 'LIKE', -NOT_LIKE => 'NOT LIKE', -LIKE_BINARY => 'LIKE BINARY', -NOT_LIKE_BINARY => 'NOT LIKE BINARY', }; my $OP_TYPE_MAP = { in => { 'IN' => 1, 'NOT IN' => 1, }, between => { 'BETWEEN' => 1, 'NOT BETWEEN' => 1, }, like => { 'LIKE' => 1, 'NOT LIKE' => 1, 'LIKE BINARY' => 1, 'NOT LIKE BINARY' => 1, }, }; my $SORT_OP_ALIAS = { -ASC => 'ASC', -DESC => 'DESC', }; my $SUPPORTED_INDEX_TYPE_MAP = { USE => 1, FORCE => 1, IGNORE => 1, }; use constant { _LIMIT_OFFSET => 1, _LIMIT_XY => 2, _LIMIT_YX => 3, }; my $LIMIT_DIALECT_MAP = { LimitOffset => _LIMIT_OFFSET, # PostgreSQL, SQLite, MySQL 5.0 LimitXY => _LIMIT_XY, # MySQL LimitYX => _LIMIT_YX, # SQLite }; sub sqlf { my $format = shift; my @bind; my @tokens = split m#(%[ctwosj])(?=\W|$)#, $format; for (my $i = 1; $i < @tokens; $i += 2) { my $spec = $tokens[$i]; my $method = $SPEC_TO_METHOD_MAP->{$spec}; croak "'$spec' does not supported format" unless $method; croak sprintf "missing arguments nummber of %i and '%s' format in sqlf", ($i + 1) / 2, $spec unless @_; $tokens[$i] = $SELF->$method(shift(@_), \@bind); } return join('',@tokens), @bind; } sub _columns { my ($self, $val, $bind) = @_; my $ret; if (!defined $val) { $ret = '*'; } elsif (ref $val eq 'ARRAY') { if (@$val) { $ret = join $DELIMITER, map { my $ret; my $ref = ref $_; if ($ref eq 'HASH') { my ($term, $col) = %$_; $ret = _quote($term).' '._quote($col); } elsif ($ref eq 'ARRAY') { my ($term, $col) = @$_; $ret = ( ref $term eq 'SCALAR' ? $$term : _quote($term) ).' '._quote($col); } elsif ($ref eq 'REF' && ref $$_ eq 'ARRAY') { my ($term, $col, @params) = @{$$_}; $ret = ( ref $term eq 'SCALAR' ? $$term : _quote($term) ).' '._quote($col); push @$bind, @params; } else { $ret = _quote($_) } $ret; } @$val; } else { $ret = '*'; } } elsif (ref $val eq 'SCALAR') { $ret = $$val; } else { $ret = _quote($val); } return $ret; } sub _table { my ($self, $val, $bind) = @_; my $ret; if (ref $val eq 'ARRAY') { $ret = join $DELIMITER, map { my $v = $_; my $ret; if (ref $v eq 'HASH') { $ret = _complex_table_expr($v); } else { $ret = _quote($v); } $ret; } @$val; } elsif (ref $val eq 'HASH') { $ret = _complex_table_expr($val); } elsif (defined $val) { $ret = _quote($val); } else { # noop } return $ret; } sub _where { my ($self, $val, $bind) = @_; if (ref $val eq 'ARRAY') { my @ret; for my $v (@$val) { push @ret, $self->_where($v, $bind); } return @ret == 1 ? $ret[0] : join ' OR ', map { "($_)" } @ret; } return unless ref $val eq 'HASH'; my $ret = join ' AND ', map { my $org_key = $_; my $no_paren = 0; my ($k, $v) = (_quote($org_key), $val->{$_}); if (ref $v eq 'ARRAY') { if ( ref $v->[0] or (($v->[0]||'') eq '-and') or (($v->[0]||'') eq '-or') ) { # [-and => qw/foo bar baz/] # [-and => { '>' => 10 }, { '<' => 20 } ] # [-or => qw/foo bar baz/] # [-or => { '>' => 10 }, { '<' => 20 } ] # [{ '>' => 10 }, { '<' => 20 } ] my $logic = 'OR'; my @values = @$v; if ($v->[0] && $v->[0] eq '-and') { $logic = 'AND'; @values = @values[1..$#values]; } elsif ($v->[0] && $v->[0] eq '-or') { @values = @values[1..$#values]; } my @statements; for my $arg (@values) { my ($_stmt, @_bind) = sqlf('%w', { $org_key => $arg }); push @statements, $_stmt; push @$bind, @_bind; } $k = join " $logic ", @statements; $no_paren = 1; } elsif (@$v == 0) { # [] $k = '0=1'; } else { # [qw/1 2 3/] $k .= ' IN ('.join($DELIMITER, ('?')x@$v).')'; push @$bind, @$v; } } elsif (ref $v eq 'HASH') { my $no_paren = scalar keys %$v > 1 ? 0 : 1; $k = join ' AND ', map { my $k = $k; my ($op, $v) = (uc($_), $v->{$_}); $op = $OP_ALIAS->{$op} || $op; if ($OP_TYPE_MAP->{in}{$op}) { my $ref = ref $v; if ($ref eq 'ARRAY') { unless (@$v) { # { IN => [] } $k = $op eq 'IN' ? '0=1' : '1=1'; } else { # { IN => [qw/1 2 3/] } $k .= " $op (".join($DELIMITER, ('?')x@$v).')'; push @$bind, @$v; } } elsif ($ref eq 'REF') { # { IN => \['SELECT foo FROM bar WHERE hoge = ?', 'fuga'] $k .= " $op (${$v}->[0])"; push @$bind, @{$$v}[1..$#$$v]; } elsif ($ref eq 'SCALAR') { # { IN => \'SELECT foo FROM bar' } $k .= " $op ($$v)"; } elsif (defined $v) { # { IN => 'foo' } $k .= $op eq 'IN' ? ' = ?' : ' <> ?'; push @$bind, $v; } else { # { IN => undef } $k .= $op eq 'IN' ? ' IS NULL' : ' IS NOT NULL'; } } elsif ($OP_TYPE_MAP->{between}{$op}) { my $ref = ref $v; if ($ref eq 'ARRAY') { # { BETWEEN => ['foo', 'bar'] } # { BETWEEN => [\'lower(x)', \['upper(?)', 'y']] } my ($va, $vb) = @$v; my @stmt; for my $value ($va, $vb) { if (ref $value eq 'SCALAR') { push @stmt, $$value; } elsif (ref $value eq 'REF') { push @stmt, ${$value}->[0]; push @$bind, @{$$value}[1..$#$$value]; } else { push @stmt, '?'; push @$bind, $value; } } $k .= " $op ".join ' AND ', @stmt; } elsif ($ref eq 'REF') { # { BETWEEN => \["? AND ?", 1, 2] } $k .= " $op ${$v}->[0]"; push @$bind, @{$$v}[1..$#$$v]; } elsif ($ref eq 'SCALAR') { # { BETWEEN => \'lower(x) AND upper(y)' } $k .= " $op $$v"; } else { # { BETWEEN => $scalar } # noop } } elsif ($OP_TYPE_MAP->{like}{$op}) { my $ref = ref $v; my $escape_char; if ($ref eq 'HASH') { ($escape_char, $v) = %$v; $ref = ref $v; } if ($ref eq 'ARRAY') { # { LIKE => ['%foo', 'bar%'] } # { LIKE => [\'"%foo"', \'"bar%"'] } my @stmt; for my $value (@$v) { if (ref $value eq 'SCALAR') { push @stmt, $$value; } else { push @stmt, '?'; push @$bind, $value; } if ($escape_char) { $stmt[-1] .= ' ESCAPE ?'; push @$bind, $escape_char; } } $k = join ' OR ', map { "$k $op $_" } @stmt; } elsif ($ref eq 'SCALAR') { # { LIKE => \'"foo%"' } $k .= " $op $$v"; if ($escape_char) { $k .= ' ESCAPE ?'; push @$bind, $escape_char; } } else { $k .= " $op ?"; push @$bind, $v; if ($escape_char) { $k .= ' ESCAPE ?'; push @$bind, $escape_char; } } } elsif (ref $v eq 'SCALAR') { # { '>' => \'foo' } $k .= " $op $$v"; } elsif (ref $v eq 'ARRAY') { if ($op eq '=') { unless (@$v) { $k = '0=1'; } else { $k .= " IN (".join($DELIMITER, ('?')x@$v).')'; push @$bind, @$v; } } elsif ($op eq '!=') { unless (@$v) { $k = '1=1'; } else { $k .= " NOT IN (".join($DELIMITER, ('?')x@$v).')'; push @$bind, @$v; } } else { # { '>' => [qw/1 2 3/] } $k .= join ' OR ', map { "$op ?" } @$v; push @$bind, @$v; } } elsif (ref $v eq 'REF' && ref $$v eq 'ARRAY') { # { '>' => \['UNIX_TIMESTAMP(?)', '2012-12-12 00:00:00'] } $k .= " $op ${$v}->[0]"; push @$bind, @{$$v}[1..$#$$v]; } else { # { '>' => 'foo' } $k .= " $op ?"; push @$bind, $v; } $no_paren ? $k : "($k)"; } sort keys %$v; } elsif (ref $v eq 'REF' && ref $$v eq 'ARRAY') { $k .= " IN ($$v->[0])"; push @$bind, @{$$v}[1..$#$$v]; } elsif (ref $v eq 'SCALAR') { # \'foo' $k .= " $$v"; } elsif (!defined $v) { # undef $k .= ' IS NULL'; } else { # 'foo' $k .= ' = ?'; push @$bind, $v; } $no_paren ? $k : "($k)"; } sort keys %$val; return $ret; } sub _options { my ($self, $val, $bind) = @_; my @exprs; if (exists $val->{group_by}) { my $ret = _sort_expr($val->{group_by}); push @exprs, 'GROUP BY '.$ret; } if (exists $val->{having}) { my ($ret, @new_bind) = sqlf('%w', $val->{having}); push @exprs, 'HAVING '.$ret; push @$bind, @new_bind; } if (exists $val->{order_by}) { my $ret = _sort_expr($val->{order_by}); push @exprs, 'ORDER BY '.$ret; } if (defined(my $group_by = $val->{group_by})) { } if (defined $val->{limit}) { my $ret = 'LIMIT '; if ($val->{offset}) { # defined and > 0 my $limit_dialect = $LIMIT_DIALECT_MAP->{$LIMIT_DIALECT} || 0; if ($limit_dialect == _LIMIT_OFFSET) { $ret .= "$val->{limit} OFFSET $val->{offset}"; } elsif ($limit_dialect == _LIMIT_XY) { $ret .= "$val->{offset}, $val->{limit}"; } elsif ($limit_dialect == _LIMIT_YX) { $ret .= "$val->{limit}, $val->{offset}"; } else { warn "Unkown LIMIT_DIALECT `$LIMIT_DIALECT`"; $ret .= $val->{limit}; } } else { $ret .= $val->{limit}; } push @exprs, $ret; } return join ' ', @exprs; } sub _join { my ($self, $val, $bind) = @_; my @statements; $val = [$val] unless ref $val eq 'ARRAY'; for my $param (@$val) { croak '%j mast be HASH ref specified' unless ref $param eq 'HASH'; croak 'table and condition options must be specified at %j' unless $param->{table} && $param->{condition}; my $ret = sprintf '%s JOIN ', uc($param->{type} || 'INNER'); $ret .= $self->_table($param->{table}, $bind); if (ref $param->{condition} eq 'ARRAY') { $ret .= ' USING ('.( join $DELIMITER, map { _quote($_) } @{$param->{condition}} ).')'; } elsif (ref $param->{condition} eq 'HASH') { my $cond = $param->{condition}; my $no_paren = keys %$cond > 1 ? 0 : 1; $ret .= ' ON '.(join ' AND ', map { my ($k, $v) = ($_, $cond->{$_}); my $ret; if (ref $v eq 'HASH') { my $no_paren = keys %$v > 1 ? 0 : 1; $ret = join ' AND ', map { my $op = $_; my $ret; if (ref $v->{$op} eq 'REF' && ref ${$v->{$op}} eq 'ARRAY') { my $v = ${$v->{$op}}; $ret = _quote($k)." $op ".$v->[0]; push @$bind, @{$v}[1..$#$v]; } else { $ret = _quote($k)." $op "._quote($v->{$_}); } $no_paren ? $ret : "($ret)"; } sort keys %$v; } elsif (ref $v eq 'REF' && ref $$v eq 'ARRAY') { my $v = $$v; $ret = _quote($k).' = '._quote($v->[0]); push @$bind, @{$v}[1..$#$v]; } else { $ret = _quote($k).' = '._quote($v); } $no_paren ? $ret : "($ret)"; } sort keys %$cond); } else { $ret .= ' ON '.$param->{condition}; } push @statements, $ret; } return join ' ', @statements; } sub _quote { my $stuff = shift; return $$stuff if ref $stuff eq 'SCALAR'; return $stuff unless $QUOTE_CHAR && $NAME_SEP; return $stuff if $stuff eq '*'; return $stuff if substr($stuff, 0, 1) eq $QUOTE_CHAR; # skip if maybe quoted return $stuff if $stuff =~ /\(/; # skip if maybe used function return join $NAME_SEP, map { "$QUOTE_CHAR$_$QUOTE_CHAR" } split /\Q$NAME_SEP\E/, $stuff; } sub _complex_table_expr { my $stuff = shift; my $ret = join $DELIMITER, map { my ($k, $v) = ($_, $stuff->{$_}); my $ret = _quote($k); if (ref $v eq 'HASH') { $ret .= ' '._quote($v->{alias}) if $v->{alias}; if (exists $v->{index} && ref $v->{index}) { my $type = uc($v->{index}{type} || 'USE'); croak "unkown index type: $type" unless $SUPPORTED_INDEX_TYPE_MAP->{$type}; croak "keys field must be specified in index option" unless defined $v->{index}{keys}; my $keys = $v->{index}{keys}; $keys = [ $keys ] unless ref $keys eq 'ARRAY'; $ret .= " $type INDEX (".join($DELIMITER, map { _quote($_) } @$keys ).")"; } } else { $ret .= ' '._quote($v); } $ret; } sort keys %$stuff; return $ret; } sub _sort_expr { my $stuff = shift; my $ret = ''; if (!defined $stuff) { # undef $ret .= 'NULL'; } elsif (ref $stuff eq 'HASH') { # { colA => 'DESC' } # { -asc => 'colB' } $ret .= join $DELIMITER, map { if (my $sort_op = $SORT_OP_ALIAS->{uc $_}) { _quote($stuff->{$_}).' '.$sort_op, } else { _quote($_).' '.$stuff->{$_} } } sort keys %$stuff; } elsif (ref $stuff eq 'ARRAY') { # ['column1', { column2 => 'DESC', -asc => 'column3' }] my @parts; for my $part (@$stuff) { if (ref $part eq 'HASH') { push @parts, join $DELIMITER, map { if (my $sort_op = $SORT_OP_ALIAS->{uc $_}) { _quote($part->{$_}).' '.$sort_op, } else { _quote($_).' '.$part->{$_} } } sort keys %$part; } else { push @parts, _quote($part); } } $ret .= join $DELIMITER, @parts; } else { # 'column' $ret .= _quote($stuff); } return $ret; } sub _set { my ($self, $val, $bind) = @_; my @set = ref $val eq 'HASH' ? map { $_ => $val->{$_} } sort keys %$val : @$val; my @columns; for (my $i = 0; $i < @set; $i += 2) { my ($col, $val) = ($set[$i], $set[$i+1]); my $quoted_col = _quote($col); if (ref $val eq 'SCALAR') { # foo => { bar => \'NOW()' } push @columns, "$quoted_col = $$val"; } elsif (ref $val eq 'REF' && ref $$val eq 'ARRAY') { # foo => { bar => \['UNIX_TIMESTAMP(?)', '2011-11-11 11:11:11'] } my ($stmt, @sub_bind) = @{$$val}; push @columns, "$quoted_col = $stmt"; push @$bind, @sub_bind; } else { # foo => { bar => 'baz' } push @columns, "$quoted_col = ?"; push @$bind, $val; } } my $ret = join $self->{delimiter}, @columns; } sub new { my ($class, %args) = @_; if (exists $args{driver} && defined $args{driver}) { my $driver = lc $args{driver}; unless (defined $args{quote_char}) { $args{quote_char} = $driver eq 'mysql' ? '`' : '"'; } unless (defined $args{limit_dialect}) { $args{limit_dialect} = $driver eq 'mysql' ? 'LimitXY' : 'LimitOffset'; } } bless { delimiter => $DELIMITER, name_sep => $NAME_SEP, quote_char => $QUOTE_CHAR, limit_dialect => $LIMIT_DIALECT, %args, }, $class; } sub format { my $self = shift; local $SELF = $self; local $DELIMITER = $self->{delimiter}; local $NAME_SEP = $self->{name_sep}; local $QUOTE_CHAR = $self->{quote_char}; local $LIMIT_DIALECT = $self->{limit_dialect}; sqlf(@_); } sub select { my ($self, $table, $cols, $where, $opts) = @_; croak 'Usage: $sqlf->select($table [, \@cols, \%where, \%opts])' unless defined $table; local $SELF = $self; local $DELIMITER = $self->{delimiter}; local $NAME_SEP = $self->{name_sep}; local $QUOTE_CHAR = $self->{quote_char}; local $LIMIT_DIALECT = $self->{limit_dialect}; my $prefix = delete $opts->{prefix} || 'SELECT'; my $suffix = delete $opts->{suffix}; my $format = "$prefix %c FROM %t"; my @args = ($cols, $table); if (my $join = delete $opts->{join}) { $format .= ' %j'; push @args, $join; } if (ref $where) { $format .= ' WHERE %w'; push @args, $where; } if (keys %$opts) { $format .= ' %o'; push @args, $opts; } if ($suffix) { $format .= " $suffix"; } sqlf($format, @args); } sub insert { my ($self, $table, $values, $opts) = @_; croak 'Usage: $sqlf->insert($table \%values|\@values [, \%opts])' unless defined $table && ref $values; local $SELF = $self; local $DELIMITER = $self->{delimiter}; local $NAME_SEP = $self->{name_sep}; local $QUOTE_CHAR = $self->{quote_char}; local $LIMIT_DIALECT = $self->{limit_dialect}; my $prefix = $opts->{prefix} || 'INSERT INTO'; my $quoted_table = _quote($table); my @values = ref $values eq 'HASH' ? %$values : @$values; my (@columns, @bind_cols, @bind_params); for (my $i = 0; $i < @values; $i += 2) { my ($col, $val) = ($values[$i], $values[$i+1]); push @columns, _quote($col); if (ref $val eq 'SCALAR') { # foo => { bar => \'NOW()' } push @bind_cols, $$val; } elsif (ref $val eq 'REF' && ref $$val eq 'ARRAY') { # foo => { bar => \['UNIX_TIMESTAMP(?)', '2011-11-11 11:11:11'] } my ($stmt, @sub_bind) = @{$$val}; push @bind_cols, $stmt; push @bind_params, @sub_bind; } else { # foo => { bar => 'baz' } push @bind_cols, '?'; push @bind_params, $val; } } my $stmt = "$prefix $quoted_table " . '('.join(', ', @columns).') ' . 'VALUES ('.join($self->{delimiter}, @bind_cols).')'; return $stmt, @bind_params; } sub update { my ($self, $table, $set, $where, $opts) = @_; croak 'Usage: $sqlf->update($table \%set|\@set [, \%where, \%opts])' unless defined $table && ref $set; local $SELF = $self; local $DELIMITER = $self->{delimiter}; local $NAME_SEP = $self->{name_sep}; local $QUOTE_CHAR = $self->{quote_char}; local $LIMIT_DIALECT = $self->{limit_dialect}; my $prefix = delete $opts->{prefix} || 'UPDATE'; my $quoted_table = _quote($table); my $set_clause = $self->_set($set, \my @bind_params); my $format = "$prefix $quoted_table SET ".$set_clause; my @args; if (keys %{ $where || {} }) { $format .= ' WHERE %w'; push @args, $where; } if (keys %$opts) { $format .= ' %o'; push @args, $opts; } my ($stmt, @bind) = sqlf($format, @args); return $stmt, (@bind_params, @bind); } sub delete { my ($self, $table, $where, $opts) = @_; croak 'Usage: $sqlf->delete($table [, \%where, \%opts])' unless defined $table; local $SELF = $self; local $DELIMITER = $self->{delimiter}; local $NAME_SEP = $self->{name_sep}; local $QUOTE_CHAR = $self->{quote_char}; local $LIMIT_DIALECT = $self->{limit_dialect}; my $prefix = delete $opts->{prefix} || 'DELETE'; my $quoted_table = _quote($table); my $format = "$prefix FROM $quoted_table"; my @args; if (keys %{ $where || {} }) { $format .= ' WHERE %w'; push @args, $where; } if (keys %$opts) { $format .= ' %o'; push @args, $opts; } sqlf($format, @args); } sub insert_multi { my ($self, $table, $cols, $values, $opts) = @_; croak 'Usage: $sqlf->insert_multi($table, \@cols, [ \@values1, \@values2, ... ] [, \%opts])' unless ref $cols eq 'ARRAY' && ref $values eq 'ARRAY'; local $SELF = $self; local $DELIMITER = $self->{delimiter}; local $NAME_SEP = $self->{name_sep}; local $QUOTE_CHAR = $self->{quote_char}; local $LIMIT_DIALECT = $self->{limit_dialect}; my $prefix = $opts->{prefix} || 'INSERT INTO'; my $quoted_table = _quote($table); my $columns_num = @$cols; my @bind_params; my @values_stmt; for my $value (@$values) { my @bind_cols; for (my $i = 0; $i < $columns_num; $i++) { my $val = $value->[$i]; if (ref $val eq 'SCALAR') { # \'NOW()' push @bind_cols, $$val; } elsif (ref $val eq 'REF' && ref $$val eq 'ARRAY') { # \['UNIX_TIMESTAMP(?)', '2011-11-11 11:11:11'] my ($expr, @sub_bind) = @{$$val}; push @bind_cols, $expr; push @bind_params, @sub_bind; } else { # 'baz' push @bind_cols, '?'; push @bind_params, $val; } } push @values_stmt, '('.join($self->{delimiter}, @bind_cols).')'; } my $stmt = "$prefix $quoted_table " . '('.join($self->{delimiter}, map { _quote($_) } @$cols).') ' . 'VALUES '.join($self->{delimiter}, @values_stmt); if ($opts->{update}) { my ($update_stmt, @bind) = sqlf '%s', $opts->{update}; $stmt .= " ON DUPLICATE KEY UPDATE $update_stmt"; push @bind_params, @bind; } return $stmt, @bind_params; } sub insert_multi_from_hash { my ($self, $table, $values, $opts) = @_; croak 'Usage: $sqlf->insert_multi_from_hash($table, [ { colA => $valA, colB => $valB }, { ... } ] [, \%opts])' unless ref $values eq 'ARRAY' && ref $values->[0] eq 'HASH'; my $cols = [ keys %{$values->[0]} ]; my $new_values = []; for my $value (@$values) { push @$new_values, [ @$value{@$cols} ]; } $self->insert_multi($table, $cols, $new_values, $opts); } 1; __END__ =encoding utf-8 =for stopwords =head1 NAME SQL::Format - Yet yet another SQL builder =head1 SYNOPSIS use SQL::Format; my ($stmt, @bind) = sqlf 'SELECT %c FROM %t WHERE %w' => ( [qw/bar baz/], # %c 'foo', # %t { hoge => 'fuga', piyo => [qw/100 200 300/], }, # %w ); # $stmt: SELECT `bar`, `baz` FROM `foo` WHERE (`hoge` = ?) AND (`piyo` IN (?, ?, ?)) # @bind: ('fuga', 100, 200, 300); ($stmt, @bind) = sqlf 'SELECT %c FROM %t WHERE %w %o' => ( '*', # %c 'foo', # %t { hoge => 'fuga' }, # w { order_by => { bar => 'DESC' }, limit => 100, offset => 10, }, # %o ); # $stmt: SELECT * FROM `foo` WHERE (`hoge` = ?) ORDER BY `bar` DESC LIMIT 100 OFFSET 10 # @bind: (`fuga`) ($stmt, @bind) = sqlf 'UPDATE %t SET %s' => ( foo => { bar => 'baz', 'hoge => 'fuga' }, ); # $stmt: UPDATE `foo` SET `bar` = ?, `hoge` = ? # @bind: ('baz', 'fuga') my $sqlf = SQL::Format->new( quote_char => '', # do not quote limit_dialect => 'LimitXY', # mysql style limit-offset ); ($stmt, @bind) = $sqlf->select(foo => [qw/bar baz/], { hoge => 'fuga', }, { order_by => 'bar', limit => 100, offset => 10, }); # $stmt: SELECT bar, baz FROM foo WHERE (hoge = ?) ORDER BY bar LIMIT 10, 100 # @bind: ('fuga') ($stmt, @bind) = $sqlf->insert(foo => { bar => 'baz', hoge => 'fuga' }); # $stmt: INSERT INTO foo (bar, hoge) VALUES (?, ?) # @bind: ('baz', 'fuga') ($stmt, @bind) = $sqlf->update(foo => { bar => 'xxx' }, { hoge => 'fuga' }); # $stmt: UPDATE foo SET bar = ? WHERE hoge = ? # @bind: ('xxx', 'fuga') ($stmt, @bind) = $sqlf->delete(foo => { hoge => 'fuga' }); # $stmt: DELETE FROM foo WHERE (hoge = ?) # @bind: ('fuga') =head1 DESCRIPTION SQL::Format is a easy to SQL query building library. B<< THIS MODULE IS ALPHA LEVEL INTERFACE!! >> =head1 FUNCTIONS =head2 sqlf($format, @args) Generate SQL from formatted output conversion. my ($stmt, @bind) = sqlf 'SELECT %c FROM %t WHERE %w' => ( [qw/bar baz/], # %c 'foo', # %t { hoge => 'fuga', piyo => [100, 200, 300], }, # %w ); # $stmt: SELECT `foo` FROM `bar`, `baz WHERE (`hoge` = ?) AND (`piyo` IN (?, ?, ?)) # @bind: ('fuga', 100, 200, 300) Currently implemented formatters are: =over =item %t This format is a table name. ($stmt, @bind) = sqlf '%t', 'table_name'; # $stmt => `table_name` ($stmt, @bind) = sqlf '%t', [qw/tableA tableB/]; # $stmt => `tableA`, `tableB` ($stmt, @bind) = sqlf '%t', { tableA => 't1' }; # $stmt => `tableA` `t1` ($stmt, @bind) = sqlf '%t', { tableA => { index => { type => 'force', keys => [qw/key1 key2/] }, alias => 't1', }; # $stmt: `tableA` `t1` FORCE INDEX (`key1`, `key2`) =item %c This format is a column name. ($stmt, @bind) = sqlf '%c', 'column_name'; # $stmt => `column_name` ($stmt, @bind) = sqlf '%c', [qw/colA colB/]; # $stmt => `colA`, `colB` ($stmt, @bind) = sqlf '%c', '*'; # $stmt => * ($stmt, @bind) = sqlf '%c', [\'COUNT(*)', colC]; # $stmt => COUNT(*), `colC` =item %w This format is a where clause. ($stmt, @bind) = sqlf '%w', { foo => 'bar' }; # $stmt: (`foo` = ?) # @bind: ("bar") ($stmt, @bind) = sqlf '%w', { foo => 'bar', baz => [qw/100 200 300/], }; # $stmt: (`baz` IN (?, ?, ?) AND (`foo` = ?) # @bind: (100, 200, 300, 'bar') =item %o This format is a options. Currently specified are: =over =item limit This option makes C<< LIMIT $n >> clause. ($stmt, @bind) = sqlf '%o', { limit => 100 }; # $stmt => LIMIT 100 =item offset This option makes C<< OFFSET $n >> clause. You must be specified both limit option. ($stmt, @bind) = sqlf '%o', { limit => 100, offset => 20 }; # $stmt => LIMIT 100 OFFSET 20 You can change limit dialects from C<< $SQL::Format::LIMIT_DIALECT >>. =item order_by This option makes C<< ORDER BY >> clause. ($stmt, @bind) = sqlf '%o', { order_by => 'foo' }; # $stmt => ORDER BY `foo` ($stmt, @bind) = sqlf '%o', { order_by => { foo => 'DESC' } }; # $stmt => ORDER BY `foo` DESC ($stmt, @bind) = sqlf '%o', { order_by => ['foo', { -asc => 'bar' } ] }; # $stmt => ORDER BY `foo`, `bar` ASC =item group_by This option makes C<< GROUP BY >> clause. Argument value some as C<< order_by >> option. ($stmt, @bind) = sqlf '%o', { group_by => { foo => 'DESC' } }; # $stmt => GROUP BY `foo` DESC =item having This option makes C<< HAVING >> clause. Argument value some as C<< where >> clause. ($stmt, @bind) = sqlf '%o', { having => { foo => 'bar' } }; # $stmt: HAVING (`foo` = ?) # @bind: ('bar') =back =item %j This format is join clause. ($stmt, @bind) = sqlf '%j', { table => 'bar', condition => 'foo.id = bar.id' }; # $stmt: INNER JOIN `bar` ON (foo.id = bar.id) ($stmt, @bind) = sqlf '%j', { type => 'left', table => { bar => 'b' }, condition => { 'f.id' => 'b.id', 'f.updated_at' => \['UNIX_TIMESTAMP()', '2012-12-12'] 'f.created_at' => { '>' => 'b.created_at' }, }, }; # $stmt: LEFT JOIN `bar` `b` ON (`f`.`id` = `b.id`) =item %s This format is set clause. ($stmt, @bind) = sqlf '%s', { bar => 'baz' }; # $stmt: `bar` = ? # @bind: ('baz') ($stmt, @bind) = sqlf '%s', { bar => 'baz', 'hoge' => \'UNIX_TIMESTAMP()' }; # $stmt: `bar` = ?, `hoge` = UNIX_TIMESTAMP() # @bind: ('baz') ($stmt, @bind) = sqlf '%s', { bar => 'baz', hoge => \['CONCAT(?, ?)', 'ya', 'ppo'], }; # $stmt: `bar` = ?, `hoge` = CONCAT(?, ?) # @bind: ('baz', 'ya', 'ppo') =back For more examples, see also L<< SQL::Format::Spec >>. You can change the behavior by changing the global variable. =over =item $SQL::Format::QUOTE_CHAR : Str This is a quote character for table or column name. Default value is C<< "`" >>. =item $SQL::Format::NAME_SEP : Str This is a separate character for table or column name. Default value is C<< "." >>. =item $SQL::Format::DELIMITER Str This is a delimiter for between columns. Default value is C<< ", " >>. =item $SQL::Format::LIMIT_DIALECT : Str This is a types for dialects of limit-offset. You can choose are: LimitOffset # LIMIT 100 OFFSET 20 (SQLite / PostgreSQL / MySQL) LimitXY # LIMIT 20, 100 (MySQL / SQLite) LimitYX # LIMIT 100, 20 (other) Default value is C<< LimitOffset" >>. =back =head1 METHODS =head2 new([%options]) Create a new instance of C<< SQL::Format >>. my $sqlf = SQL::Format->new( quote_char => '', limit_dialect => 'LimitXY', ); C<< %options >> specify are: =over =item quote_char : Str Default value is C<< $SQL::Format::QUOTE_CHAR >>. =item name_sep : Str This is a separate character for table or column name. Default value is C<< $SQL::Format::NAME_SEP >>. =item delimiter: Str This is a delimiter for between columns. Default value is C<< $SQL::Format::DELIMITER >>. =item limit_dialect : Str This is a types for dialects of limit-offset. Default value is C<< $SQL::Format::LIMIT_DIALECT >>. =back =head2 format($format, \%args) This method same as C<< sqlf >> function. my ($stmt, @bind) = $self->format('SELECT %c FROM %t WHERE %w', [qw/bar baz/], 'foo', { hoge => 'fuga' }, ); # $stmt: SELECT `bar`, `baz` FROM ` foo` WHERE (`hoge` = ?) # @bind: ('fuga') =head2 select($table|\@table, $column|\@columns [, \%where, \%opts ]) This method returns SQL string and bind parameters for C<< SELECT >> statement. my ($stmt, @bind) = $sqlf->select(foo => [qw/bar baz/], { hoge => 'fuga', piyo => [100, 200, 300], }); # $stmt: SELECT `foo` FROM `bar`, `baz` WHERE (`hoge` = ?) AND (`piyo` IN (?, ?, ?)) # @bind: ('fuga', 100, 200, 300) Argument details are: =over =item $table | \@table Same as C<< %t >> format. =item $column | \@columns Same as C<< %c >> format. =item \%where Same as C<< %w >> format. =item \%opts =over =item $opts->{prefix} This is prefix for SELECT statement. my ($stmt, @bind) = $sqlf->select(foo => '*', { bar => 'baz' }, { prefix => 'SELECT SQL_CALC_FOUND_ROWS' }); # $stmt: SELECT SQL_CALC_FOUND_ROWS * FROM `foo` WHERE (`bar` = ?) # @bind: ('baz') Default value is C<< SELECT >>. =item $opts->{suffix} Additional value for after the SELECT statement. my ($stmt, @bind) = $sqlf->select(foo => '*', { bar => 'baz' }, { suffix => 'FOR UPDATE' }); # $stmt: SELECT * FROM `foo` WHERE (bar = ?) FOR UPDATE # @bind: ('baz') Default value is C<< '' >> =item $opts->{limit} =item $opts->{offset} =item $opts->{order_by} =item $opts->{group_by} =item $opts->{having} =item $opts->{join} See also C<< %o >> format. =back =back =head2 insert($table, \%values|\@values [, \%opts ]) This method returns SQL string and bind parameters for C<< INSERT >> statement. my ($stmt, @bind) = $sqlf->insert(foo => { bar => 'baz', hoge => 'fuga' }); # $stmt: INSERT INTO `foo` (`bar`, `hoge`) VALUES (?, ?) # @bind: ('baz', 'fuga') my ($stmt, @bind) = $sqlf->insert(foo => [ hoge => \'NOW()', fuga => \['UNIX_TIMESTAMP()', '2012-12-12 12:12:12'], ]); # $stmt: INSERT INTO `foo` (`hoge`, `fuga`) VALUES (NOW(), UNIX_TIMESTAMP(?)) # @bind: ('2012-12-12 12:12:12') Argument details are: =over =item $table This is a table name for target of INSERT. =item \%values | \@values This is a VALUES clause INSERT statement. Currently supported types are: # \%values case { foo => 'bar' } { foo => \'NOW()' } { foo => \['UNIX_TIMESTAMP()', '2012-12-12 12:12:12'] } # \@values case [ foo => 'bar' ] [ foo => \'NOW()' ] [ foo => \['UNIX_TIMESTAMP()', '2012-12-12 12:12:12'] ] =item \%opts =over =item $opts->{prefix} This is a prefix for INSERT statement. my ($stmt, @bind) = $sqlf->insert(foo => { bar => baz }, { prefix => 'INSERT IGNORE' }); # $stmt: INSERT IGNORE INTO `foo` (`bar`) VALUES (?) # @bind: ('baz') Default value is C<< INSERT >>. =back =back =head2 update($table, \%set|\@set [, \%where, \%opts ]) This method returns SQL string and bind parameters for C<< UPDATE >> statement. my ($stmt, @bind) = $sqlf->update(foo => { bar => 'baz' }, { hoge => 'fuga' }); # $stmt: UPDATE `foo` SET `bar` = ? WHERE (`hoge` = ?) # @bind: ('baz', 'fuga') Argument details are: =over =item $table This is a table name for target of UPDATE. =item \%set | \@set This is a SET clause for INSERT statement. Currently supported types are: # \%values case { foo => 'bar' } { foo => \'NOW()' } { foo => \['UNIX_TIMESTAMP()', '2012-12-12 12:12:12'] } # \@values case [ foo => 'bar' ] [ foo => \'NOW()' ] [ foo => \['UNIX_TIMESTAMP()', '2012-12-12 12:12:12'] ] =item \%where Same as C<< %w >> format. =item \%opts =over =item $opts->{prefix} This is a prefix for UPDATE statement. my ($stmt, @bind) = $sqlf->update( 'foo' # table { bar => 'baz' }, # sets { hoge => 'fuga' }, # where { prefix => 'UPDATE LOW_PRIORITY' }, # opts ); # $stmt: UPDATE LOW_PRIORITY `foo` SET `bar` = ? WHERE (`hoge` = ?) # @bind: ('baz', 'fuga') Default value is C<< UPDATE >>. =item $opts->{order_by} =item $opts->{limit} See also C<< %o >> format. =back =back =head2 delete($table [, \%where, \%opts ]) This method returns SQL string and bind parameters for C<< DELETE >> statement. my ($stmt, @bind) = $sqlf->delete(foo => { bar => 'baz' }); # $stmt: DELETE FROM `foo` WHERE (`bar = ?) # @bind: ('baz') Argument details are: =over =item $table This is a table name for target of DELETE. =item \%where Same as C<< %w >> format. =item \%opts =over =item $opts->{prefix} This is a prefix for DELETE statement. my ($stmt, @bind) = $sqlf->delete(foo => { bar => 'baz' }, { prefix => 'DELETE LOW_PRIORITY' }); # $stmt: DELETE LOW_PRIORITY FROM `foo` WHERE (`bar` = ?) # @bind: ('baz') Default value is C<< DELETE >>. =item $opts->{order_by} =item $opts->{limit} See also C<< %o >> format. =back =back =head2 insert_multi($table, \@cols, \@values [, \%opts]) This method returns SQL string and bind parameters for bulk insert. my ($stmt, @bind) = $self->insert_multi( foo => [qw/bar baz/], [ [qw/hoge fuga/], [qw/fizz buzz/], ], ); # $stmt: INSERT INTO `foo` (`bar`, `baz`) VALUES (?, ?), (?, ?) # @bind: (qw/hoge fuga fizz buzz/) Argument details are: =over =item $table This is a table name for target of INSERT. =item \@cols This is a columns for target of INSERT. =item \@values This is a values parameters. Must be ARRAY within ARRAY. my ($stmt, @bind) = $sqlf->insert_multi( foo => [qw/bar baz/], [ [qw/foo bar/], [\'NOW()', \['UNIX_TIMESTAMP(?)', '2012-12-12 12:12:12'] ], ], ); # $stmt: INSERT INTO `foo` (`bar`, `baz`) VALUES (?, ?), (NOW(), UNIX_TIMESTAMP(?)) # @bind: (qw/foo bar/, '2012-12-12 12:12:12') =item \%opts =over =item $opts->{prefix} This is a prefix for INSERT statement. my ($stmt, @bind) = $sqlf->insert_multi(..., { prefix => 'INSERT IGNORE INTO' }); # $stmt: INSERT IGNORE INTO ... Default value is C<< INSERT INTO >>. =item $opts->{update} Some as C<< %s >> format. If this value specified then add C<< ON DUPLICATE KEY UPDATE >> statement. my ($stmt, @bind) = $sqlf->insert_multi( foo => [qw/bar baz/], [ [qw/hoge fuga/], [qw/fizz buzz/], ], { update => { bar => 'piyo' } }, ); # $stmt: INSERT INTO `foo` (`bar`, `baz`) VALUES (?, ?), (?, ?) ON DUPLICATE KEY UPDATE `bar` = ? # @bind: (qw/hoge fuga fizz buzz piyo/) =back =back =head2 insert_multi_from_hash($table, \@values [, \%opts]) This method is a wrapper for C<< insert_multi() >>. Argument dialects are: =over =item $table Same as C<< insert_multi() >> =item \@values This is a values parameters. Must be HASH within ARRAY. my ($stmt, @bind) = $sqlf->insert_multi_from_hash(foo => [ { bar => 'hoge', baz => 'fuga' }, { bar => 'fizz', baz => 'buzz' }, ]); # $stmt: INSERT INTO `foo` (`bar`, `baz`) VALUES (?, ?), (?, ?) # @bind: (qw/hoge fuga fizz buzz/) =item \%opts Same as C<< insert_multi() >> =back =head1 AUTHOR xaicron E<lt>xaicron {at} cpan.orgE<gt> =head1 COPYRIGHT Copyright 2012 - xaicron =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L<< SQL::Format::Spec >> L<< SQL::Maker >> L<< SQL::Abstract >> =cut