DBIx-Custom / lib / DBIx / Custom / SQLTemplate.pm /
Newer Older
382 lines | 10.651kb
many many changes
yuki-kimoto authored on 2010-04-30
1
package DBIx::Custom::SQLTemplate;
2

            
3
use strict;
4
use warnings;
5

            
6
use base 'Object::Simple';
simplify filtering system
yuki-kimoto authored on 2010-05-01
7

            
many many changes
yuki-kimoto authored on 2010-04-30
8
use Carp 'croak';
9
use DBIx::Custom::Query;
compile success
yuki-kimoto authored on 2010-05-01
10
use DBIx::Custom::SQLTemplate::TagProcessor;
many many changes
yuki-kimoto authored on 2010-04-30
11

            
12
__PACKAGE__->dual_attr('tag_processors', default => sub { {} },
13
                                         inherit => 'hash_copy');
14

            
15
__PACKAGE__->dual_attr('tag_start', default => '{', inherit => 'scalar_copy');
16
__PACKAGE__->dual_attr('tag_end',   default => '}', inherit => 'scalar_copy');
17

            
18
__PACKAGE__->dual_attr('tag_syntax', inherit => 'scalar_copy');
19

            
simplify filtering system
yuki-kimoto authored on 2010-05-01
20
__PACKAGE__->resist_tag_processor(
many many changes
yuki-kimoto authored on 2010-04-30
21
    '?'      => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag,
22
    '='      => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag,
23
    '<>'     => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag,
24
    '>'      => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag,
25
    '<'      => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag,
26
    '>='     => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag,
27
    '<='     => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag,
28
    'like'   => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag,
29
    'in'     => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_in_tag,
30
    'insert' => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_insert_tag,
31
    'update' => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_update_tag
32
);
33

            
34
__PACKAGE__->tag_syntax(<< 'EOS');
35
[tag]                     [expand]
36
{? name}                  ?
37
{= name}                  name = ?
38
{<> name}                 name <> ?
39

            
40
{< name}                  name < ?
41
{> name}                  name > ?
42
{>= name}                 name >= ?
43
{<= name}                 name <= ?
44

            
45
{like name}               name like ?
46
{in name number}          name in [?, ?, ..]
47

            
48
{insert key1 key2} (key1, key2) values (?, ?)
49
{update key1 key2}    set key1 = ?, key2 = ?
50
EOS
51

            
52

            
simplify filtering system
yuki-kimoto authored on 2010-05-01
53
sub resist_tag_processor {
many many changes
yuki-kimoto authored on 2010-04-30
54
    my $invocant = shift;
55
    my $tag_processors = ref $_[0] eq 'HASH' ? $_[0] : {@_};
56
    $invocant->tag_processors({%{$invocant->tag_processors}, %{$tag_processors}});
57
    return $invocant;
58
}
59

            
60
sub clone {
61
    my $self = shift;
62
    my $new = $self->new;
63
    
64
    $new->tag_start($self->tag_start);
65
    $new->tag_end($self->tag_end);
66
    $new->tag_syntax($self->tag_syntax);
67
    $new->tag_processors({%{$self->tag_processors || {}}});
68
    
69
    return $new;
70
}
71

            
72
sub create_query {
73
    my ($self, $template)  = @_;
74
    
75
    # Parse template
76
    my $tree = $self->_parse_template($template);
77
    
78
    # Build query
79
    my $query = $self->_build_query($tree);
80
    
81
    return $query;
82
}
83

            
84
sub _parse_template {
85
    my ($self, $template) = @_;
86
    
87
    if (ref $template eq 'ARRAY') {
88
        $template = $template->[1];
89
    }
90
    $template ||= '';
91
    
92
    my $tree = [];
93
    
94
    # Tags
95
    my $tag_start = quotemeta $self->tag_start;
96
    my $tag_end   = quotemeta $self->tag_end;
97
    
98
    # Tokenize
99
    my $state = 'text';
100
    
101
    # Save original template
102
    my $original_template = $template;
103
    
104
    # Parse template
105
    while ($template =~ s/([^$tag_start]*?)$tag_start([^$tag_end].*?)$tag_end//sm) {
106
        my $text = $1;
107
        my $tag  = $2;
108
        
109
        # Parse tree
110
        push @$tree, {type => 'text', tag_args => [$text]} if $text;
111
        
112
        if ($tag) {
113
            # Get tag name and arguments
114
            my ($tag_name, @tag_args) = split /\s+/, $tag;
115
            
116
            # Tag processor is exist?
117
            unless ($self->tag_processors->{$tag_name}) {
118
                my $tag_syntax = $self->tag_syntax;
119
                croak("Tag '{$tag}' in SQL template is not exist.\n\n" .
120
                      "<SQL template tag syntax>\n" .
121
                      "$tag_syntax\n" .
122
                      "<Your SQL template>\n" .
123
                      "$original_template\n\n");
124
            }
125
            
126
            # Check tag arguments
127
            foreach my $tag_arg (@tag_args) {
128
                # Cannot cantain placehosder '?'
129
                croak("Tag '{t }' arguments cannot contain '?'")
130
                  if $tag_arg =~ /\?/;
131
            }
132
            
133
            # Add tag to parsing tree
134
            push @$tree, {type => 'tag', tag_name => $tag_name, tag_args => [@tag_args]};
135
        }
136
    }
137
    
138
    # Add text to parsing tree 
139
    push @$tree, {type => 'text', tag_args => [$template]} if $template;
140
    
141
    return $tree;
142
}
143

            
144
sub _build_query {
145
    my ($self, $tree) = @_;
146
    
147
    # SQL
148
    my $sql = '';
149
    
150
    # All parameter key infomation
simplify filtering system
yuki-kimoto authored on 2010-05-01
151
    my $all_columns = [];
many many changes
yuki-kimoto authored on 2010-04-30
152
    
153
    # Build SQL 
154
    foreach my $node (@$tree) {
155
        
156
        # Get type, tag name, and arguments
157
        my $type     = $node->{type};
158
        my $tag_name = $node->{tag_name};
159
        my $tag_args = $node->{tag_args};
160
        
161
        # Text
162
        if ($type eq 'text') {
163
            # Join text
164
            $sql .= $tag_args->[0];
165
        }
166
        
167
        # Tag
168
        elsif ($type eq 'tag') {
169
            
170
            # Get tag processor
171
            my $tag_processor = $self->tag_processors->{$tag_name};
172
            
173
            # Tag processor is code ref?
174
            croak("Tag processor '$tag_name' must be code reference")
175
              unless ref $tag_processor eq 'CODE';
176
            
177
            # Expand tag using tag processor
simplify filtering system
yuki-kimoto authored on 2010-05-01
178
            my ($expand, $columns) = $tag_processor->($tag_name, $tag_args);
many many changes
yuki-kimoto authored on 2010-04-30
179
            
180
            # Check tag processor return value
simplify filtering system
yuki-kimoto authored on 2010-05-01
181
            croak("Tag processor '$tag_name' must return (\$expand, \$columns)")
182
              if !defined $expand || ref $columns ne 'ARRAY';
many many changes
yuki-kimoto authored on 2010-04-30
183
            
184
            # Check placeholder count
185
            croak("Placeholder count in SQL created by tag processor '$tag_name' " .
186
                  "must be same as key informations count")
simplify filtering system
yuki-kimoto authored on 2010-05-01
187
              unless $self->_placeholder_count($expand) eq @$columns;
many many changes
yuki-kimoto authored on 2010-04-30
188
            
189
            # Add key information
simplify filtering system
yuki-kimoto authored on 2010-05-01
190
            push @$all_columns, @$columns;
many many changes
yuki-kimoto authored on 2010-04-30
191
            
192
            # Join expand tag to SQL
193
            $sql .= $expand;
194
        }
195
    }
196
    
197
    # Add semicolon
198
    $sql .= ';' unless $sql =~ /;$/;
199
    
200
    # Query
simplify filtering system
yuki-kimoto authored on 2010-05-01
201
    my $query = DBIx::Custom::Query->new(sql => $sql, columns => $all_columns);
many many changes
yuki-kimoto authored on 2010-04-30
202
    
203
    return $query;
204
}
205

            
206
sub _placeholder_count {
207
    my ($self, $expand) = @_;
208
    $expand ||= '';
209
    
210
    my $count = 0;
211
    my $pos   = -1;
212
    while (($pos = index($expand, '?', $pos + 1)) != -1) {
213
        $count++;
214
    }
215
    return $count;
216
}
217

            
218
1;
219

            
220
=head1 NAME
221

            
222
DBIx::Custom::SQLTemplate - DBIx::Custom SQL Template
223

            
224
=head1 SYNOPSIS
225
    
226
    my $sql_tmpl = DBIx::Custom::SQLTemplate->new;
227
    
228
    my $tmpl   = "select from table {= k1} && {<> k2} || {like k3}";
229
    my $param = {k1 => 1, k2 => 2, k3 => 3};
230
    
231
    my $query = $sql_template->create_query($tmpl);
232

            
233
=head1 ATTRIBUTES
234

            
235
=head2 tag_processors
236

            
237
    $sql_tmpl       = $sql_tmpl->tag_processors($name1 => $tag_processor1
238
                                                $name2 => $tag_processor2);
239
    $tag_processors = $sql_tmpl->tag_processors;
240

            
241
=head2 tag_start
242
    
243
    $sql_tmpl  = $sql_tmpl->tag_start('{');
244
    $tag_start = $sql_tmpl->tag_start;
245

            
246
Default is '{'
247

            
248
=head2 tag_end
249
    
250
    $sql_tmpl    = $sql_tmpl->tag_start('}');
251
    $tag_end = $sql_tmpl->tag_start;
252

            
253
Default is '}'
254
    
255
=head2 tag_syntax
256
    
257
    $sql_tmpl   = $sql_tmpl->tag_syntax($tag_syntax);
258
    $tag_syntax = $sql_tmpl->tag_syntax;
259

            
260
=head1 METHODS
261

            
262
This class is L<Object::Simple> subclass.
263
You can use all methods of L<Object::Simple>
264

            
265
=head2 create_query
266
    
267
Create L<DBIx::Custom::Query> object parsing SQL template
268

            
269
    $query = $sql_tmpl->create_query($tmpl);
270
    
271
    # Sample
272
    $query = $sql_tmpl->create_sql(
273
         "select * from table where {= title} && {like author} || {<= price}")
274
    
275
    # Expanded
276
    $qeury->sql : "select * from table where title = ? && author like ? price <= ?;"
277
    $query->key_infos : [['title'], ['author'], ['price']]
278
    
279
    # Sample with table name
280
    ($sql, @bind_values) = $sql_tmpl->create_sql(
281
            "select * from table where {= table.title} && {like table.author}",
282
            {table => {title => 'Perl', author => '%Taro%'}}
283
        )
284
    
285
    # Expanded
286
    $query->sql : "select * from table where table.title = ? && table.title like ?;"
287
    $query->key_infos :[ [['table.title'],['table', 'title']],
288
                         [['table.author'],['table', 'author']] ]
289

            
290
This method create query using by L<DBIx::Custom>.
291
query has two infomation
292

            
293
    1. sql       : SQL
294
    2. key_infos : Parameter access key information
295

            
simplify filtering system
yuki-kimoto authored on 2010-05-01
296
=head2 resist_tag_processor
many many changes
yuki-kimoto authored on 2010-04-30
297

            
298
Add tag processor
299
    
simplify filtering system
yuki-kimoto authored on 2010-05-01
300
    $sql_tmpl = $sql_tmpl->resist_tag_processor($tag_processor);
many many changes
yuki-kimoto authored on 2010-04-30
301

            
simplify filtering system
yuki-kimoto authored on 2010-05-01
302
The following is resist_tag_processor sample
many many changes
yuki-kimoto authored on 2010-04-30
303

            
simplify filtering system
yuki-kimoto authored on 2010-05-01
304
    $sql_tmpl->resist_tag_processor(
many many changes
yuki-kimoto authored on 2010-04-30
305
        '?' => sub {
306
            my ($tag_name, $tag_args) = @_;
307
            
308
            my $key1 = $tag_args->[0];
309
            my $key2 = $tag_args->[1];
310
            
311
            my $key_infos = [];
312
            
313
            # Expand tag and create key informations
314
            
315
            # Return expand tags and key informations
316
            return ($expand, $key_infos);
317
        }
318
    );
319

            
320
Tag processor recieve 2 argument
321

            
322
    1. Tag name            (?, =, <>, or etc)
323
    2. Tag arguments       (arg1 and arg2 in {tag_name arg1 arg2})
324

            
325
Tag processor return 2 value
326

            
327
    1. Expanded Tag (For exsample, '{= title}' is expanded to 'title = ?')
328
    2. Key infomations
329
    
330
You must be return expanded tag and key infomations.
331

            
332
Key information is a little complex. so I will explan this in future.
333

            
334
If you want to know more, Please see DBIx::Custom::SQLTemplate source code.
335

            
336
=head2 clone
337

            
338
Clone DBIx::Custom::SQLTemplate object
339

            
340
    $clone = $sql_tmpl->clone;
341
    
342
=head1 Available Tags
343
    
344
Available Tags
345

            
346
    [tag]            [expand]
347
    {? name}         ?
348
    {= name}         name = ?
349
    {<> name}        name <> ?
350
    
351
    {< name}         name < ?
352
    {> name}         name > ?
353
    {>= name}        name >= ?
354
    {<= name}        name <= ?
355
    
356
    {like name}      name like ?
357
    {in name}        name in [?, ?, ..]
358
    
359
    {insert}         (key1, key2, key3) values (?, ?, ?)
360
    {update}         set key1 = ?, key2 = ?, key3 = ?
361
    
362

            
363
The following is insert SQL sample
364

            
365
    $query = $sql_tmpl->create_sql(
366
        "insert into table {insert key1 key2}"
367
    );
368
    
369
    # Expanded
370
    $query->sql : "insert into table (key1, key2) values (?, ?)"
371

            
372
The following is update SQL sample
373
    
374
    $query = $sql_tmpl->create_sql(
375
        "update table {update key1 key2} where {= key3}"
376
    );
377
    
378
    # Expanded
379
    $query->sql : "update table set key1 = ?, key2 = ? where key3 = ?;"
380
    
381
=cut
382