Commit | Line | Data |
d10d5b94 |
1 | package SQL::Abstract::Plugin::BangOverrides; |
2 | |
3 | use Moo; |
4 | |
5 | with 'SQL::Abstract::Role::Plugin'; |
6 | |
7 | sub register_extensions { |
8 | my ($self, $sqla) = @_; |
9 | foreach my $stmt ($sqla->statement_list) { |
2ed2b14f |
10 | $sqla->wrap_expander($stmt => sub { |
11 | my ($orig) = @_; |
d10d5b94 |
12 | sub { |
13 | my ($self, $name, $args) = @_; |
2ed2b14f |
14 | my %args = ( |
15 | %$args, |
16 | (ref($args->{order_by}) eq 'HASH' |
17 | ? %{$args->{order_by}} |
18 | : ()) |
19 | ); |
20 | my %overrides; |
d10d5b94 |
21 | foreach my $clause (map /^!(.*)$/, keys %args) { |
22 | my $override = delete $args{"!${clause}"}; |
2ed2b14f |
23 | $overrides{$clause} = ( |
d10d5b94 |
24 | ref($override) eq 'CODE' |
2ed2b14f |
25 | ? $self->$override($args{$clause}) |
d10d5b94 |
26 | : $override |
27 | ); |
28 | } |
2ed2b14f |
29 | $self->$orig($name, { %$args, %overrides }); |
d10d5b94 |
30 | } |
31 | }); |
32 | } |
33 | } |
34 | |
35 | 1; |
b1016840 |
36 | |
37 | __END__ |
38 | |
39 | =head1 NAME |
40 | |
41 | SQL::Abstract::Plugin::BangOverrides |
42 | |
43 | =head2 SYNOPSIS |
44 | |
45 | $sqla->plugin('+BangOverrides'); |
46 | ... |
47 | profit(); |
48 | |
49 | =head1 METHODS |
50 | |
51 | =head2 register_extensions |
52 | |
53 | Wraps all currently existing clause based statements such that when a clause |
54 | of '!name' is encountered, if its value is a coderef, it's called with the |
55 | original value of the 'name' clause and expected to return a replacement, and |
56 | if not, it's simply used as a direct replacement. |
57 | |
58 | So, given appropriate DBIC setup: |
59 | |
60 | $s->storage->sqlmaker->plugin('+ExtraClauses')->plugin('+BangOverrides'); |
61 | |
62 | my $rs2 = $s->resultset('Foo')->search({ |
63 | -op => [ '=', { -ident => 'outer.y' }, { -ident => 'me.x' } ] |
64 | }, { |
65 | with_recursive => [ outer => $rs->get_column('x')->as_query ], |
66 | }); |
67 | # (SELECT me.x, me.y, me.z FROM foo me WHERE ( outer.y = me.x )) |
68 | |
69 | my $rs3 = $rs2->search({}, { |
70 | '!from' => sub { my ($sqla, $from) = @_; |
71 | my $base = $sqla->expand_expr({ -old_from => $from }); |
72 | return [ $base, -join => [ 'wub', on => [ 'me.z' => 'wub.z' ] ] ]; |
73 | } |
74 | }); |
75 | # (SELECT me.x, me.y, me.z FROM foo me JOIN wub ON me.z = wub.z WHERE ( outer.y = me.x )) |
76 | |
77 | my $rs4 = $rs3->search({}, { |
78 | '!with' => [ [ qw(wub x y z) ], $s->resultset('Bar')->as_query ], |
79 | }); |
80 | # (WITH wub(x, y, z) AS (SELECT me.a, me.b, me.c FROM bar me) SELECT me.x, me.y, me.z FROM foo me JOIN wub ON me.z = wub.z WHERE ( outer.y = me.x )) |
81 | |
82 | my $rs5 = $rs->search({}, { select => [ { -coalesce => [ { -ident => 'x' }, { -value => 7 } ] } ] }); |
83 | # (SELECT -COALESCE( -IDENT( x ), -VALUE( 7 ) ) FROM foo me WHERE ( z = ? )) |
84 | |
85 | my $rs6 = $rs->search({}, { '!select' => [ { -coalesce => [ { -ident => 'x' }, { -value => 7 } ] } ] }); |
86 | # (SELECT COALESCE(x, ?) FROM foo me WHERE ( z = ? )) |
87 | |
88 | =cut |