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 | |
8ab93c47 |
58 | This allows for passing data through existing systems that attempt to have |
59 | their own handling for thing but whose capabilities are now superceded by |
60 | L<SQL::Abstract>, and is primarily useful to provide access to experimental |
61 | feature bundles such as L<SQL::Abstract::Plugin::ExtraClauses>. |
62 | |
63 | As an example of such a thing, given an appropriate DBIC setup |
64 | (see C<examples/bangdbic>): |
b1016840 |
65 | |
66 | $s->storage->sqlmaker->plugin('+ExtraClauses')->plugin('+BangOverrides'); |
67 | |
68 | my $rs2 = $s->resultset('Foo')->search({ |
69 | -op => [ '=', { -ident => 'outer.y' }, { -ident => 'me.x' } ] |
b1016840 |
70 | }); |
71 | # (SELECT me.x, me.y, me.z FROM foo me WHERE ( outer.y = me.x )) |
72 | |
73 | my $rs3 = $rs2->search({}, { |
74 | '!from' => sub { my ($sqla, $from) = @_; |
75 | my $base = $sqla->expand_expr({ -old_from => $from }); |
76 | return [ $base, -join => [ 'wub', on => [ 'me.z' => 'wub.z' ] ] ]; |
77 | } |
78 | }); |
79 | # (SELECT me.x, me.y, me.z FROM foo me JOIN wub ON me.z = wub.z WHERE ( outer.y = me.x )) |
80 | |
81 | my $rs4 = $rs3->search({}, { |
82 | '!with' => [ [ qw(wub x y z) ], $s->resultset('Bar')->as_query ], |
83 | }); |
84 | # (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 )) |
85 | |
86 | my $rs5 = $rs->search({}, { select => [ { -coalesce => [ { -ident => 'x' }, { -value => 7 } ] } ] }); |
87 | # (SELECT -COALESCE( -IDENT( x ), -VALUE( 7 ) ) FROM foo me WHERE ( z = ? )) |
88 | |
89 | my $rs6 = $rs->search({}, { '!select' => [ { -coalesce => [ { -ident => 'x' }, { -value => 7 } ] } ] }); |
90 | # (SELECT COALESCE(x, ?) FROM foo me WHERE ( z = ? )) |
91 | |
92 | =cut |