From 2bf08e0657cb28bad05c181d586dbb50e62aa8f5 Mon Sep 17 00:00:00 2001 From: Sebastian Riedel Date: Sat, 20 Feb 2021 17:58:02 +0100 Subject: [PATCH] Move SQL::Abstract::Pg into a separate distribution --- Changes | 3 +- Makefile.PL | 2 +- lib/Mojo/Pg.pm | 2 - lib/SQL/Abstract/Pg.pm | 340 ----------------------------------------- t/pod_coverage.t | 6 +- t/sql.t | 155 ------------------- 6 files changed, 4 insertions(+), 504 deletions(-) delete mode 100644 lib/SQL/Abstract/Pg.pm delete mode 100644 t/sql.t diff --git a/Changes b/Changes index d687a6b..5ed8ac5 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,6 @@ -4.25 2021-02-06 +4.25 2021-02-20 + - Moved SQL::Abstract::Pg into a separate distribution. 4.24 2021-01-27 - Fixed Mojolicious 8.72 support. diff --git a/Makefile.PL b/Makefile.PL index 9174215..680c1ce 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -29,6 +29,6 @@ WriteMakefile( x_IRC => {url => 'irc://chat.freenode.net/#mojo', web => 'https://webchat.freenode.net/#mojo'} }, }, - PREREQ_PM => {'DBD::Pg' => 3.007004, Mojolicious => '8.50', 'SQL::Abstract' => '1.86'}, + PREREQ_PM => {'DBD::Pg' => 3.007004, Mojolicious => '8.50', 'SQL::Abstract::Pg' => '1.0'}, test => {TESTS => 't/*.t t/*/*.t'} ); diff --git a/lib/Mojo/Pg.pm b/lib/Mojo/Pg.pm index 433c1be..3c47f4d 100644 --- a/lib/Mojo/Pg.pm +++ b/lib/Mojo/Pg.pm @@ -494,8 +494,6 @@ This is the class hierarchy of the L distribution. =item * L -=item * L - =back =head1 AUTHOR diff --git a/lib/SQL/Abstract/Pg.pm b/lib/SQL/Abstract/Pg.pm deleted file mode 100644 index 36073cf..0000000 --- a/lib/SQL/Abstract/Pg.pm +++ /dev/null @@ -1,340 +0,0 @@ -package SQL::Abstract::Pg; -use Mojo::Base 'SQL::Abstract'; - -BEGIN { *puke = \&SQL::Abstract::puke } - -sub insert { - my ($self, $table, $data, $options) = @_; - local @{$options}{qw(returning _pg_returning)} = (1, 1) if exists $options->{on_conflict} && !$options->{returning}; - return $self->SUPER::insert($table, $data, $options); -} - -sub new { - my $self = shift->SUPER::new(@_); - - # -json op - push @{$self->{unary_ops}}, { - regex => qr/^json$/, - handler => sub { '?', {json => $_[2]} } - }; - - return $self; -} - -sub _insert_returning { - my ($self, $options) = @_; - - delete $options->{returning} if $options->{_pg_returning}; - - # ON CONFLICT - my $sql = ''; - my @bind; - if (exists $options->{on_conflict}) { - my $conflict = $options->{on_conflict}; - my ($conflict_sql, @conflict_bind); - $self->_SWITCH_refkind( - $conflict => { - ARRAYREF => sub { - my ($target, $set) = @$conflict; - puke 'on_conflict value must be in the form [$target, \%set]' unless ref $set eq 'HASH'; - $target = [$target] unless ref $target eq 'ARRAY'; - - $conflict_sql = '(' . join(', ', map { $self->_quote($_) } @$target) . ')'; - $conflict_sql .= $self->_sqlcase(' do update set '); - my ($set_sql, @set_bind) = $self->_update_set_values($set); - $conflict_sql .= $set_sql; - push @conflict_bind, @set_bind; - }, - ARRAYREFREF => sub { ($conflict_sql, @conflict_bind) = @$$conflict }, - SCALARREF => sub { $conflict_sql = $$conflict }, - UNDEF => sub { $conflict_sql = $self->_sqlcase('do nothing') } - } - ); - $sql .= $self->_sqlcase(' on conflict ') . $conflict_sql; - push @bind, @conflict_bind; - } - - $sql .= $self->SUPER::_insert_returning($options) if $options->{returning}; - - return $sql, @bind; -} - -sub _order_by { - my ($self, $options) = @_; - - # Legacy - return $self->SUPER::_order_by($options) if ref $options ne 'HASH' or grep {/^-(?:desc|asc)/i} keys %$options; - - # GROUP BY - my $sql = ''; - my @bind; - if (defined(my $group = $options->{group_by})) { - my $group_sql; - $self->_SWITCH_refkind( - $group => { - ARRAYREF => sub { - $group_sql = join ', ', map { $self->_quote($_) } @$group; - }, - SCALARREF => sub { $group_sql = $$group } - } - ); - $sql .= $self->_sqlcase(' group by ') . $group_sql; - } - - # HAVING - if (defined(my $having = $options->{having})) { - my ($having_sql, @having_bind) = $self->_recurse_where($having); - $sql .= $self->_sqlcase(' having ') . $having_sql; - push @bind, @having_bind; - } - - # ORDER BY - $sql .= $self->_order_by($options->{order_by}) if defined $options->{order_by}; - - # LIMIT - if (defined $options->{limit}) { - $sql .= $self->_sqlcase(' limit ') . '?'; - push @bind, $options->{limit}; - } - - # OFFSET - if (defined $options->{offset}) { - $sql .= $self->_sqlcase(' offset ') . '?'; - push @bind, $options->{offset}; - } - - # FOR - if (defined(my $for = $options->{for})) { - my $for_sql; - $self->_SWITCH_refkind( - $for => { - SCALAR => sub { - puke qq{for value "$for" is not allowed} unless $for eq 'update'; - $for_sql = $self->_sqlcase('UPDATE'); - }, - SCALARREF => sub { $for_sql .= $$for } - } - ); - $sql .= $self->_sqlcase(' for ') . $for_sql; - } - - return $sql, @bind; -} - -sub _select_fields { - my ($self, $fields) = @_; - - return $fields unless ref $fields eq 'ARRAY'; - - my (@fields, @bind); - for my $field (@$fields) { - $self->_SWITCH_refkind( - $field => { - ARRAYREF => sub { - puke 'field alias must be in the form [$name => $alias]' if @$field < 2; - push @fields, $self->_quote($field->[0]) . $self->_sqlcase(' as ') . $self->_quote($field->[1]); - }, - ARRAYREFREF => sub { - push @fields, shift @$$field; - push @bind, @$$field; - }, - SCALARREF => sub { push @fields, $$field }, - FALLBACK => sub { push @fields, $self->_quote($field) } - } - ); - } - - return join(', ', @fields), @bind; -} - -sub _table { - my ($self, $table) = @_; - - return $self->SUPER::_table($table) unless ref $table eq 'ARRAY'; - - my (@table, @join); - for my $t (@$table) { - if (ref $t eq 'ARRAY') { push @join, $t } - else { push @table, $t } - } - - $table = $self->SUPER::_table(\@table); - my $sep = $self->{name_sep} // ''; - for my $join (@join) { - puke 'join must be in the form [$table, $fk => $pk]' if @$join < 3; - my ($type, $name, $fk, $pk, @morekeys) = @$join % 2 == 0 ? @$join : ('', @$join); - $table - .= $self->_sqlcase($type =~ /^-(.+)$/ ? " $1 join " : ' join ') - . $self->_quote($name) - . $self->_sqlcase(' on ') . '('; - do { - $table - .= $self->_quote(index($fk, $sep) > 0 ? $fk : "$name.$fk") . ' = ' - . $self->_quote(index($pk, $sep) > 0 ? $pk : "$table[0].$pk") - . (@morekeys ? $self->_sqlcase(' and ') : ')'); - } while ($fk, $pk, @morekeys) = @morekeys; - } - - return $table; -} - -1; - -=encoding utf8 - -=head1 NAME - -SQL::Abstract::Pg - PostgreSQL - -=head1 SYNOPSIS - - use SQL::Abstract::Pg; - - my $abstract = SQL::Abstract::Pg->new; - say $abstract->select('some_table'); - -=head1 DESCRIPTION - -L extends L with a few PostgreSQL features used by L. - -=head2 JSON - -In many places (as supported by L) you can use the C<-json> unary op to encode JSON from Perl data -structures. - - # "UPDATE some_table SET foo = '[1,2,3]' WHERE bar = 23" - $abstract->update('some_table', {foo => {-json => [1, 2, 3]}}, {bar => 23}); - - # "SELECT * FROM some_table WHERE foo = '[1,2,3]'" - $abstract->select('some_table', '*', {foo => {'=' => {-json => [1, 2, 3]}}}); - -=head1 INSERT - - $abstract->insert($table, \@values || \%fieldvals, \%options); - -=head2 ON CONFLICT - -The C option can be used to generate C queries with C clauses. So far, C to -pass C, array references to pass C with conflict targets and a C expression, scalar -references to pass literal SQL and array reference references to pass literal SQL with bind values are supported. - - # "INSERT INTO t (a) VALUES ('b') ON CONFLICT DO NOTHING" - $abstract->insert('t', {a => 'b'}, {on_conflict => undef}); - - # "INSERT INTO t (a) VALUES ('b') ON CONFLICT DO NOTHING" - $abstract->insert('t', {a => 'b'}, {on_conflict => \'do nothing'}); - -This includes operations commonly referred to as C. - - # "INSERT INTO t (a) VALUES ('b') ON CONFLICT (a) DO UPDATE SET a = 'c'" - $abstract->insert('t', {a => 'b'}, {on_conflict => [a => {a => 'c'}]}); - - # "INSERT INTO t (a, b) VALUES ('c', 'd') ON CONFLICT (a, b) DO UPDATE SET a = 'e'" - $abstract->insert('t', {a => 'c', b => 'd'}, {on_conflict => [['a', 'b'] => {a => 'e'}]}); - - # "INSERT INTO t (a) VALUES ('b') ON CONFLICT (a) DO UPDATE SET a = 'c'" - $abstract->insert('t', {a => 'b'}, {on_conflict => \['(a) do update set a = ?', 'c']}); - -=head1 SELECT - - $abstract->select($source, $fields, $where, $order); - $abstract->select($source, $fields, $where, \%options); - -=head2 AS - -The C<$fields> argument now also accepts array references containing array references with field names and aliases, as -well as array references containing scalar references to pass literal SQL and array reference references to pass -literal SQL with bind values. - - # "SELECT foo AS bar FROM some_table" - $abstract->select('some_table', [[foo => 'bar']]); - - # "SELECT foo, bar AS baz, yada FROM some_table" - $abstract->select('some_table', ['foo', [bar => 'baz'], 'yada']); - - # "SELECT EXTRACT(EPOCH FROM foo) AS foo, bar FROM some_table" - $abstract->select('some_table', [\'extract(epoch from foo) AS foo', 'bar']); - - # "SELECT 'test' AS foo, bar FROM some_table" - $abstract->select('some_table', [\['? AS foo', 'test'], 'bar']); - -=head2 JOIN - -The C<$source> argument now also accepts array references containing not only table names, but also array references -with tables to generate C clauses for. - - # "SELECT * FROM foo JOIN bar ON (bar.foo_id = foo.id)" - $abstract->select(['foo', ['bar', foo_id => 'id']]); - - # "SELECT * FROM foo JOIN bar ON (foo.id = bar.foo_id)" - $abstract->select(['foo', ['bar', 'foo.id' => 'bar.foo_id']]); - - # "SELECT * FROM a JOIN b ON (b.a_id = a.id) JOIN c ON (c.a_id = a.id)" - $abstract->select(['a', ['b', a_id => 'id'], ['c', a_id => 'id']]); - - # "SELECT * FROM foo LEFT JOIN bar ON (bar.foo_id = foo.id)" - $abstract->select(['foo', [-left => 'bar', foo_id => 'id']]); - - # "SELECT * FROM a LEFT JOIN b ON (b.a_id = a.id AND b.a_id2 = a.id2)" - $abstract->select(['a', [-left => 'b', a_id => 'id', a_id2 => 'id2']]); - -=head2 ORDER BY - -Alternatively to the C<$order> argument accepted by L you can now also pass a hash reference with -various options. This includes C, which takes the same values as the C<$order> argument. - - # "SELECT * FROM some_table ORDER BY foo DESC" - $abstract->select('some_table', '*', undef, {order_by => {-desc => 'foo'}}); - -=head2 LIMIT/OFFSET - -The C and C options can be used to generate C queries with C clauses. So far, array references to -pass a list of fields and scalar references to pass literal SQL are supported. - - # "SELECT * FROM some_table GROUP BY foo, bar" - $abstract->select('some_table', '*', undef, {group_by => ['foo', 'bar']}); - - # "SELECT * FROM some_table GROUP BY foo, bar" - $abstract->select('some_table', '*', undef, {group_by => \'foo, bar'}); - -=head2 HAVING - -The C option can be used to generate C queries with C clauses. So far, the scalar value C to -pass C and scalar references to pass literal SQL are supported. - - # "SELECT * FROM some_table FOR UPDATE" - $abstract->select('some_table', '*', undef, {for => 'update'}); - - # "SELECT * FROM some_table FOR UPDATE SKIP LOCKED" - $abstract->select('some_table', '*', undef, {for => \'update skip locked'}); - -=head1 METHODS - -L inherits all methods from L. - -=head1 SEE ALSO - -L, L, L. - -=cut diff --git a/t/pod_coverage.t b/t/pod_coverage.t index d1d015c..436f00a 100644 --- a/t/pod_coverage.t +++ b/t/pod_coverage.t @@ -5,8 +5,4 @@ use Test::More; plan skip_all => 'set TEST_POD to enable this test (developer only!)' unless $ENV{TEST_POD}; plan skip_all => 'Test::Pod::Coverage 1.04+ required for this test!' unless eval 'use Test::Pod::Coverage 1.04; 1'; -my $private = ['insert', 'new', 'puke', 'select']; -my %RULES = ('SQL::Abstract::Pg' => {also_private => $private},); -pod_coverage_ok($_, $RULES{$_} || {}) for all_modules(); - -done_testing(); +all_pod_coverage_ok(); diff --git a/t/sql.t b/t/sql.t deleted file mode 100644 index 28d5d44..0000000 --- a/t/sql.t +++ /dev/null @@ -1,155 +0,0 @@ -use Mojo::Base -strict; - -use Test::More; -use Mojo::Pg; -use SQL::Abstract::Test import => ['is_same_sql_bind']; - -sub is_query { - my ($got, $want, $msg) = @_; - my $got_sql = shift @$got; - my $want_sql = shift @$want; - local $Test::Builder::Level = $Test::Builder::Level + 1; - is_same_sql_bind $got_sql, $got, $want_sql, $want, $msg; -} - -my $pg = Mojo::Pg->new; -my $abstract = $pg->abstract; - -subtest 'Basics' => sub { - is_query [$abstract->insert('foo', {bar => 'baz'})], ['INSERT INTO "foo" ( "bar") VALUES ( ? )', 'baz'], - 'right query'; - is_query [$abstract->select('foo', '*')], ['SELECT * FROM "foo"'], 'right query'; - is_query [$abstract->select(['foo', 'bar', 'baz'])], ['SELECT * FROM "foo", "bar", "baz"'], 'right query'; -}; - -subtest 'ON CONFLICT' => sub { - my @sql = $abstract->insert('foo', {bar => 'baz'}, {on_conflict => \'do nothing'}); - is_query \@sql, ['INSERT INTO "foo" ( "bar") VALUES ( ? ) ON CONFLICT do nothing', 'baz'], 'right query'; - @sql = $abstract->insert('foo', {bar => 'baz'}, {on_conflict => undef}); - is_query \@sql, ['INSERT INTO "foo" ( "bar") VALUES ( ? ) ON CONFLICT DO NOTHING', 'baz'], 'right query'; - @sql = $abstract->insert('foo', {bar => 'baz'}, {on_conflict => \'do nothing', returning => '*'}); - my $result = ['INSERT INTO "foo" ( "bar") VALUES ( ? ) ON CONFLICT do nothing RETURNING *', 'baz']; - is_query \@sql, $result, 'right query'; - @sql = $abstract->insert('foo', {bar => 'baz'}, {on_conflict => \['(foo) do update set foo = ?', 'yada']}); - $result = ['INSERT INTO "foo" ( "bar") VALUES ( ? )' . ' ON CONFLICT (foo) do update set foo = ?', 'baz', 'yada']; - is_query \@sql, $result, 'right query'; - @sql = $abstract->insert('foo', {bar => 'baz'}, {on_conflict => [foo => {foo => 'yada'}]}); - $result = ['INSERT INTO "foo" ( "bar") VALUES ( ? )' . ' ON CONFLICT ("foo") DO UPDATE SET "foo" = ?', 'baz', 'yada']; - is_query \@sql, $result, 'right query'; - @sql = $abstract->insert('foo', {bar => 'baz'}, {on_conflict => [['foo', 'bar'] => {foo => 'yada'}]}); - $result = ['INSERT INTO "foo" ( "bar") VALUES ( ? )' . ' ON CONFLICT ("foo", "bar") DO UPDATE SET "foo" = ?', 'baz', - 'yada']; - is_query \@sql, $result, 'right query'; -}; - -subtest 'ON CONFLICT (unsupported value)' => sub { - eval { $abstract->insert('foo', {bar => 'baz'}, {on_conflict => [[], []]}) }; - like $@, qr/on_conflict value must be in the form \[\$target, \\\%set\]/, 'right error'; - eval { $abstract->insert('foo', {bar => 'baz'}, {on_conflict => {}}) }; - like $@, qr/HASHREF/, 'right error'; -}; - -subtest 'ORDER BY' => sub { - my @sql = $abstract->select('foo', '*', {bar => 'baz'}, {-desc => 'yada'}); - is_query \@sql, ['SELECT * FROM "foo" WHERE ( "bar" = ? ) ORDER BY "yada" DESC', 'baz'], 'right query'; - @sql = $abstract->select('foo', '*', {bar => 'baz'}, {order_by => {-desc => 'yada'}}); - is_query \@sql, ['SELECT * FROM "foo" WHERE ( "bar" = ? ) ORDER BY "yada" DESC', 'baz'], 'right query'; -}; - -subtest 'LIMIT/OFFSET' => sub { - my @sql = $abstract->select('foo', '*', undef, {limit => 10, offset => 5}); - is_query \@sql, ['SELECT * FROM "foo" LIMIT ? OFFSET ?', 10, 5], 'right query'; -}; - -subtest 'GROUP BY' => sub { - my @sql = $abstract->select('foo', '*', undef, {group_by => \'bar, baz'}); - is_query \@sql, ['SELECT * FROM "foo" GROUP BY bar, baz'], 'right query'; - @sql = $abstract->select('foo', '*', undef, {group_by => ['bar', 'baz']}); - is_query \@sql, ['SELECT * FROM "foo" GROUP BY "bar", "baz"'], 'right query'; -}; - -subtest 'HAVING' => sub { - my @sql = $abstract->select('foo', '*', undef, {group_by => ['bar'], having => {baz => 'yada'}}); - is_query \@sql, ['SELECT * FROM "foo" GROUP BY "bar" HAVING "baz" = ?', 'yada'], 'right query'; - @sql - = $abstract->select('foo', '*', {bar => {'>' => 'baz'}}, {group_by => ['bar'], having => {baz => {'<' => 'bar'}}}); - my $result = ['SELECT * FROM "foo" WHERE ( "bar" > ? ) GROUP BY "bar" HAVING "baz" < ?', 'baz', 'bar']; - is_query \@sql, $result, 'right query'; -}; - -subtest 'GROUP BY (unsupported value)' => sub { - eval { $abstract->select('foo', '*', undef, {group_by => {}}) }; - like $@, qr/HASHREF/, 'right error'; -}; - -subtest 'FOR' => sub { - my @sql = $abstract->select('foo', '*', undef, {for => 'update'}); - is_query \@sql, ['SELECT * FROM "foo" FOR UPDATE'], 'right query'; - @sql = $abstract->select('foo', '*', undef, {for => \'update skip locked'}); - is_query \@sql, ['SELECT * FROM "foo" FOR update skip locked'], 'right query'; -}; - -subtest 'FOR (unsupported value)' => sub { - eval { $abstract->select('foo', '*', undef, {for => 'update skip locked'}) }; - like $@, qr/for value "update skip locked" is not allowed/, 'right error'; - eval { $abstract->select('foo', '*', undef, {for => []}) }; - like $@, qr/ARRAYREF/, 'right error'; -}; - -subtest 'AS' => sub { - my @sql = $abstract->select('foo', ['bar', [bar => 'baz'], 'yada']); - is_query \@sql, ['SELECT "bar", "bar" AS "baz", "yada" FROM "foo"'], 'right query'; - @sql = $abstract->select('foo', ['bar', \'extract(epoch from baz) as baz', 'yada']); - is_query \@sql, ['SELECT "bar", extract(epoch from baz) as baz, "yada" FROM "foo"'], 'right query'; - @sql = $abstract->select('foo', ['bar', \['? as baz', 'test'], 'yada']); - is_query \@sql, ['SELECT "bar", ? as baz, "yada" FROM "foo"', 'test'], 'right query'; -}; - -subtest 'AS (unsupported value)' => sub { - eval { $abstract->select('foo', [[]]) }; - like $@, qr/field alias must be in the form \[\$name => \$alias\]/, 'right error'; -}; - -subtest 'JSON' => sub { - my @sql = $abstract->update('foo', {bar => {-json => [1, 2, 3]}}); - is_query \@sql, ['UPDATE "foo" SET "bar" = ?', {json => [1, 2, 3]}], 'right query'; - @sql = $abstract->select('foo', '*', {bar => {'=' => {-json => [1, 2, 3]}}}); - is_query \@sql, ['SELECT * FROM "foo" WHERE ( "bar" = ? )', {json => [1, 2, 3]}], 'right query'; -}; - -subtest 'JOIN' => sub { - my @sql = $abstract->select(['foo', ['bar', foo_id => 'id']]); - is_query \@sql, ['SELECT * FROM "foo" JOIN "bar" ON ("bar"."foo_id" = "foo"."id")'], 'right query'; - @sql = $abstract->select(['foo', ['bar', 'foo.id' => 'bar.foo_id']]); - is_query \@sql, ['SELECT * FROM "foo" JOIN "bar" ON ("foo"."id" = "bar"."foo_id")'], 'right query'; - @sql = $abstract->select(['foo', ['bar', 'foo.id' => 'bar.foo_id', 'foo.id2' => 'bar.foo_id2']]); - is_query \@sql, - ['SELECT * FROM "foo" JOIN "bar" ON ("foo"."id" = "bar"."foo_id"' . ' AND "foo"."id2" = "bar"."foo_id2"' . ')'], - 'right query'; - @sql = $abstract->select(['foo', ['bar', foo_id => 'id'], ['baz', foo_id => 'id']]); - my $result - = [ 'SELECT * FROM "foo"' - . ' JOIN "bar" ON ("bar"."foo_id" = "foo"."id")' - . ' JOIN "baz" ON ("baz"."foo_id" = "foo"."id")' - ]; - is_query \@sql, $result, 'right query'; - @sql = $abstract->select(['foo', [-left => 'bar', foo_id => 'id']]); - is_query \@sql, ['SELECT * FROM "foo" LEFT JOIN "bar" ON ("bar"."foo_id" = "foo"."id")'], 'right query'; - @sql = $abstract->select(['foo', [-right => 'bar', foo_id => 'id']]); - is_query \@sql, ['SELECT * FROM "foo" RIGHT JOIN "bar" ON ("bar"."foo_id" = "foo"."id")'], 'right query'; - @sql = $abstract->select(['foo', [-inner => 'bar', foo_id => 'id']]); - is_query \@sql, ['SELECT * FROM "foo" INNER JOIN "bar" ON ("bar"."foo_id" = "foo"."id")'], 'right query'; - @sql = $abstract->select(['foo', [-left => 'bar', foo_id => 'id', foo_id2 => 'id2', foo_id3 => 'id3']]); - is_query \@sql, - [ 'SELECT * FROM "foo" LEFT JOIN "bar" ON ("bar"."foo_id" = "foo"."id"' - . ' AND "bar"."foo_id2" = "foo"."id2"' - . ' AND "bar"."foo_id3" = "foo"."id3"' . ')' - ], 'right query'; -}; - -subtest 'JOIN (unsupported value)' => sub { - eval { $abstract->select(['foo', []]) }; - like $@, qr/join must be in the form \[\$table, \$fk => \$pk\]/, 'right error'; -}; - -done_testing();