DBIx-Custom / lib / DBIx / Custom / QueryBuilder.pm /
Newer Older
335 lines | 7.876kb
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
1
package DBIx::Custom::QueryBuilder;
2

            
3
use strict;
4
use warnings;
5

            
6
use base 'Object::Simple';
7

            
8
use Carp 'croak';
9
use DBIx::Custom::Query;
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
10
use DBIx::Custom::QueryBuilder::TagProcessors;
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
11

            
12
__PACKAGE__->dual_attr('tag_processors', default => sub { {} }, inherit => 'hash_copy');
13
__PACKAGE__->register_tag_processor(
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
14
    '?'     => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_placeholder_tag,
15
    '='     => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_equal_tag,
16
    '<>'    => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_not_equal_tag,
17
    '>'     => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_greater_than_tag,
18
    '<'     => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_lower_than_tag,
19
    '>='    => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_greater_than_equal_tag,
20
    '<='    => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_lower_than_equal_tag,
21
    'like'  => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_like_tag,
22
    'in'    => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_in_tag,
23
    'insert_param' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_insert_param_tag,
24
    'update_param' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_update_param_tag
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
25
);
26

            
27
__PACKAGE__->attr(tag_start => '{');
28
__PACKAGE__->attr(tag_end   => '}');
29

            
30
sub register_tag_processor {
31
    my $self = shift;
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
32
    
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
33
    # Merge tag processor
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
34
    my $tag_processors = ref $_[0] eq 'HASH' ? $_[0] : {@_};
35
    $self->tag_processors({%{$self->tag_processors}, %{$tag_processors}});
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
36
    
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
37
    return $self;
38
}
39

            
40
sub build_query {
41
    my ($self, $source)  = @_;
42
    
43
    # Parse
44
    my $tree = $self->_parse($source);
45
    
46
    # Build query
47
    my $query = $self->_build_query($tree);
48
    
49
    return $query;
50
}
51

            
52
sub _parse {
53
    my ($self, $source) = @_;
54
    
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
55
    # Source
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
56
    $source ||= '';
fixed tests
yuki-kimoto authored on 2010-08-06
57

            
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
58
    # Tree
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
59
    my $tree = [];
60
    
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
61
    # Start tag
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
62
    my $tag_start = quotemeta $self->tag_start;
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
63
    croak qq{tag_start must be a charactor}
64
      if !$tag_start || length $tag_start == 1;
65
    
66
    # End tag
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
67
    my $tag_end   = quotemeta $self->tag_end;
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
68
    croak qq{tag_end must be a charactor}
69
      if !$tag_end || length $tag_end == 1;
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
70
    
71
    # Tokenize
72
    my $state = 'text';
73
    
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
74
    # Save original source
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
75
    my $original = $source;
76
    
77
    # Parse
78
    while ($source =~ s/([^$tag_start]*?)$tag_start([^$tag_end].*?)$tag_end//sm) {
79
        my $text = $1;
80
        my $tag  = $2;
81
        
82
        # Parse tree
83
        push @$tree, {type => 'text', tag_args => [$text]} if $text;
84
        
85
        if ($tag) {
86
            # Get tag name and arguments
87
            my ($tag_name, @tag_args) = split /\s+/, $tag;
88
            
fixed tests
yuki-kimoto authored on 2010-08-06
89
            # Tag processor not registered
90
            croak qq{Tag "$tag_name" in "$original" is not registered}
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
91
               unless $self->tag_processors->{$tag_name};
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
92
            
93
            # Add tag to parsing tree
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
94
            push @$tree, {type => 'tag', tag_name => $tag_name,
95
                          tag_args => [@tag_args]};
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
96
        }
97
    }
98
    
99
    # Add text to parsing tree 
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
100
    push @$tree, {type => 'text', tag_args => [$source]}
101
      if $source;
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
102
    
103
    return $tree;
104
}
105

            
106
sub _build_query {
107
    my ($self, $tree) = @_;
108
    
109
    # SQL
110
    my $sql = '';
111
    
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
112
    # All Columns
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
113
    my $all_columns = [];
114
    
115
    # Build SQL 
116
    foreach my $node (@$tree) {
117
        
118
        # Get type, tag name, and arguments
119
        my $type     = $node->{type};
120
        my $tag_name = $node->{tag_name};
121
        my $tag_args = $node->{tag_args};
122
        
123
        # Text
124
        if ($type eq 'text') {
125
            # Join text
126
            $sql .= $tag_args->[0];
127
        }
128
        
129
        # Tag
130
        elsif ($type eq 'tag') {
131
            
132
            # Get tag processor
133
            my $tag_processor = $self->tag_processors->{$tag_name};
134
            
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
135
            # Tag processor not sub reference
136
            croak qq{Tag processor "$tag_name" must be sub reference}
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
137
              unless ref $tag_processor eq 'CODE';
138
            
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
139
            # Execute tag processor
fixed tests
yuki-kimoto authored on 2010-08-06
140
            my $r = $tag_processor->(@$tag_args);
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
141
            
142
            # Check tag processor return value
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
143
            croak qq{Tag processor "$tag_name" must return [STRING, ARRAY_REFERENCE]}
fixed tests
yuki-kimoto authored on 2010-08-06
144
              unless ref $r eq 'ARRAY' && defined $r->[0] && ref $r->[1] eq 'ARRAY';
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
145
            
fixed tests
yuki-kimoto authored on 2010-08-06
146
            # Part of SQL statement and colum names
147
            my ($part, $columns) = @$r;
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
148
            
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
149
            # Add columns
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
150
            push @$all_columns, @$columns;
151
            
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
152
            # Join part tag to SQL
153
            $sql .= $part;
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
154
        }
155
    }
fixed tests
yuki-kimoto authored on 2010-08-06
156

            
157
    # Check placeholder count
158
    my $placeholder_count = $self->_placeholder_count($sql);
159
    my $column_count      = @$all_columns;
160
    croak qq{Placeholder count in "$sql" must be same as column count $column_count}
161
      unless $placeholder_count eq @$all_columns;
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
162
    
163
    # Add semicolon
164
    $sql .= ';' unless $sql =~ /;$/;
165
    
166
    # Query
167
    my $query = DBIx::Custom::Query->new(sql => $sql, columns => $all_columns);
168
    
169
    return $query;
170
}
171

            
172
sub _placeholder_count {
173
    my ($self, $expand) = @_;
174
    
changed argument of tag proc...
yuki-kimoto authored on 2010-08-03
175
    # Count
176
    $expand ||= '';
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
177
    my $count = 0;
178
    my $pos   = -1;
179
    while (($pos = index($expand, '?', $pos + 1)) != -1) {
180
        $count++;
181
    }
182
    return $count;
183
}
184

            
185
1;
186

            
187
=head1 NAME
188

            
189
DBIx::Custom::QueryBuilder - Query builder
190

            
191
=head1 SYNOPSIS
192
    
193
    my $builder = DBIx::Custom::QueryBuilder->new;
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
194
    my $query = $builder->build_query(
195
        "select from table {= k1} && {<> k2} || {like k3}"
196
    );
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
197

            
198
=head1 ATTRIBUTES
199

            
200
=head2 C<tag_processors>
201

            
202
    my $tag_processors = $builder->tag_processors;
203
    $builder           = $builder->tag_processors(\%tag_processors);
204

            
205
Tag processors.
206

            
207
=head2 C<tag_start>
208
    
209
    my $tag_start = $builder->tag_start;
210
    $builder      = $builder->tag_start('{');
211

            
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
212
Tag start charactor.
213
Default to '{'.
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
214

            
215
=head2 C<tag_end>
216
    
217
    my $tag_end = $builder->tag_start;
218
    $builder    = $builder->tag_start('}');
219

            
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
220
Tag end charactor.
221
Default to '}'.
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
222
    
223
=head1 METHODS
224

            
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
225
L<DBIx::Custom::QueryBuilder> inherits all methods from L<Object::Simple>
226
and implements the following new ones.
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
227

            
228
=head2 C<build_query>
229
    
230
    my $query = $builder->build_query($source);
231

            
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
232
Create a new L<DBIx::Custom::Query> object from SQL source.
233
SQL source contains tags, such as {= title}, {like author}.
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
234

            
235
B<Example:>
236

            
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
237
SQL source
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
238

            
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
239
      "select * from table where {= title} && {like author} || {<= price}"
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
240

            
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
241
Query
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
242

            
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
243
    {
244
        sql     => "select * from table where title = ? && author like ? price <= ?;"
245
        columns => ['title', 'author', 'price']
246
    }
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
247

            
248
=head2 C<register_tag_processor>
249

            
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
250
    $builder->register_tag_processor(\%tag_processors);
251
    $builder->register_tag_processor(%tag_processors);
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
252

            
253
Register tag processor.
254

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
255
B<Example:>
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
256

            
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
257
    $builder->register_tag_processor(
258
        '?' => sub {
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
259
            my $column = shift;
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
260
            
remove DBIx::Custom::QueryBu...
yuki-kimoto authored on 2010-08-05
261
            return ['?', [$column]];
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
262
        }
263
    );
264

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
265
See also L<DBIx::Custom::QueryBuilder::TagProcessors> to know tag processor.
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
266

            
267
=head1 Tags
268

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
269
The following tags is available.
update document
yuki-kimoto authored on 2010-08-07
270

            
271
=head2 C<?>
272

            
273
Placeholder tag.
274

            
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
275
    {? NAME}    ->   ?
update document
yuki-kimoto authored on 2010-08-07
276

            
277
=head2 C<=>
278

            
279
Equal tag.
280

            
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
281
    {= NAME}    ->   NAME = ?
update document
yuki-kimoto authored on 2010-08-07
282

            
283
=head2 C<E<lt>E<gt>>
284

            
285
Not equal tag.
286

            
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
287
    {<> NAME}   ->   NAME <> ?
update document
yuki-kimoto authored on 2010-08-07
288

            
289
=head2 C<E<lt>>
290

            
291
Lower than tag
292

            
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
293
    {< NAME}    ->   NAME < ?
update document
yuki-kimoto authored on 2010-08-07
294

            
295
=head2 C<E<gt>>
296

            
297
Greater than tag
298

            
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
299
    {> NAME}    ->   NAME > ?
update document
yuki-kimoto authored on 2010-08-07
300

            
301
=head2 C<E<gt>=>
302

            
303
Greater than or equal tag
304

            
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
305
    {>= NAME}   ->   NAME >= ?
update document
yuki-kimoto authored on 2010-08-07
306

            
307
=head2 C<E<lt>=>
308

            
309
Lower than or equal tag
310

            
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
311
    {<= NAME}   ->   NAME <= ?
update document
yuki-kimoto authored on 2010-08-07
312

            
313
=head2 C<like>
314

            
315
Like tag
316

            
317
    {like NAME}   ->   NAME like ?
318

            
319
=head2 C<in>
320

            
321
In tag.
322

            
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
323
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
update document
yuki-kimoto authored on 2010-08-07
324

            
325
=head2 C<insert>
326

            
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
327
Insert parameter tag.
update document
yuki-kimoto authored on 2010-08-07
328

            
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
329
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
update document
yuki-kimoto authored on 2010-08-07
330

            
331
=head2 C<update>
332

            
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
333
Updata parameter tag.
update document
yuki-kimoto authored on 2010-08-07
334

            
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
335
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?