DBIx-Custom / lib / DBIx / Custom / SQLTemplate.pm /
Newer Older
374 lines | 10.318kb
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

            
add query filter error check
yuki-kimoto authored on 2010-05-14
12
__PACKAGE__->attr('tag_processors' => sub { {} });
13

            
14
__PACKAGE__->attr(tag_start => '{');
15
__PACKAGE__->attr(tag_end   => '}');
16

            
17
__PACKAGE__->attr('tag_syntax' => <<'EOS');
many many changes
yuki-kimoto authored on 2010-04-30
18
[tag]                     [expand]
19
{? name}                  ?
20
{= name}                  name = ?
21
{<> name}                 name <> ?
22

            
23
{< name}                  name < ?
24
{> name}                  name > ?
25
{>= name}                 name >= ?
26
{<= name}                 name <= ?
27

            
28
{like name}               name like ?
29
{in name number}          name in [?, ?, ..]
30

            
31
{insert key1 key2} (key1, key2) values (?, ?)
32
{update key1 key2}    set key1 = ?, key2 = ?
33
EOS
34

            
add query filter error check
yuki-kimoto authored on 2010-05-14
35
sub new {
36
    my $self = shift->SUPER::new;
37
    
38
    $self->register_tag_processor(
39
        '?'      => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_placeholder_tag,
40
        '='      => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag,
41
        '<>'     => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag,
42
        '>'      => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag,
43
        '<'      => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag,
44
        '>='     => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag,
45
        '<='     => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag,
46
        'like'   => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_basic_tag,
47
        'in'     => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_in_tag,
48
        'insert' => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_insert_tag,
49
        'update' => \&DBIx::Custom::SQLTemplate::TagProcessors::expand_update_tag
50
    );
51
    
52
    return $self;
53
}
many many changes
yuki-kimoto authored on 2010-04-30
54

            
some changed
yuki-kimoto authored on 2010-05-02
55
sub register_tag_processor {
add query filter error check
yuki-kimoto authored on 2010-05-14
56
    my $self = shift;
many many changes
yuki-kimoto authored on 2010-04-30
57
    my $tag_processors = ref $_[0] eq 'HASH' ? $_[0] : {@_};
add query filter error check
yuki-kimoto authored on 2010-05-14
58
    $self->tag_processors({%{$self->tag_processors}, %{$tag_processors}});
59
    return $self;
many many changes
yuki-kimoto authored on 2010-04-30
60
}
61

            
62
sub create_query {
63
    my ($self, $template)  = @_;
64
    
65
    # Parse template
66
    my $tree = $self->_parse_template($template);
67
    
68
    # Build query
69
    my $query = $self->_build_query($tree);
70
    
71
    return $query;
72
}
73

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

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

            
196
sub _placeholder_count {
197
    my ($self, $expand) = @_;
198
    $expand ||= '';
199
    
200
    my $count = 0;
201
    my $pos   = -1;
202
    while (($pos = index($expand, '?', $pos + 1)) != -1) {
203
        $count++;
204
    }
205
    return $count;
206
}
207

            
208
1;
209

            
210
=head1 NAME
211

            
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
212
DBIx::Custom::SQLTemplate - SQL template system
many many changes
yuki-kimoto authored on 2010-04-30
213

            
214
=head1 SYNOPSIS
215
    
216
    my $sql_tmpl = DBIx::Custom::SQLTemplate->new;
217
    
218
    my $tmpl   = "select from table {= k1} && {<> k2} || {like k3}";
219
    my $param = {k1 => 1, k2 => 2, k3 => 3};
220
    
221
    my $query = $sql_template->create_query($tmpl);
222

            
223
=head1 ATTRIBUTES
224

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
225
=head2 C<tag_processors>
many many changes
yuki-kimoto authored on 2010-04-30
226

            
227
    $sql_tmpl       = $sql_tmpl->tag_processors($name1 => $tag_processor1
228
                                                $name2 => $tag_processor2);
229
    $tag_processors = $sql_tmpl->tag_processors;
230

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
231
=head2 C<tag_start>
many many changes
yuki-kimoto authored on 2010-04-30
232
    
233
    $sql_tmpl  = $sql_tmpl->tag_start('{');
234
    $tag_start = $sql_tmpl->tag_start;
235

            
236
Default is '{'
237

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
238
=head2 C<tag_end>
many many changes
yuki-kimoto authored on 2010-04-30
239
    
240
    $sql_tmpl    = $sql_tmpl->tag_start('}');
241
    $tag_end = $sql_tmpl->tag_start;
242

            
243
Default is '}'
244
    
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
245
=head2 C<tag_syntax>
many many changes
yuki-kimoto authored on 2010-04-30
246
    
247
    $sql_tmpl   = $sql_tmpl->tag_syntax($tag_syntax);
248
    $tag_syntax = $sql_tmpl->tag_syntax;
249

            
250
=head1 METHODS
251

            
252
This class is L<Object::Simple> subclass.
253
You can use all methods of L<Object::Simple>
254

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
255
=head2 C<new>
add query filter error check
yuki-kimoto authored on 2010-05-14
256

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
257
=head2 C<create_query>
many many changes
yuki-kimoto authored on 2010-04-30
258
    
259
Create L<DBIx::Custom::Query> object parsing SQL template
260

            
261
    $query = $sql_tmpl->create_query($tmpl);
262
    
263
    # Sample
264
    $query = $sql_tmpl->create_sql(
265
         "select * from table where {= title} && {like author} || {<= price}")
266
    
267
    # Expanded
268
    $qeury->sql : "select * from table where title = ? && author like ? price <= ?;"
269
    $query->key_infos : [['title'], ['author'], ['price']]
270
    
271
    # Sample with table name
272
    ($sql, @bind_values) = $sql_tmpl->create_sql(
273
            "select * from table where {= table.title} && {like table.author}",
274
            {table => {title => 'Perl', author => '%Taro%'}}
275
        )
276
    
277
    # Expanded
278
    $query->sql : "select * from table where table.title = ? && table.title like ?;"
279
    $query->key_infos :[ [['table.title'],['table', 'title']],
280
                         [['table.author'],['table', 'author']] ]
281

            
282
This method create query using by L<DBIx::Custom>.
283
query has two infomation
284

            
285
    1. sql       : SQL
286
    2. key_infos : Parameter access key information
287

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
288
=head2 C<register_tag_processor>
many many changes
yuki-kimoto authored on 2010-04-30
289

            
290
Add tag processor
291
    
some changed
yuki-kimoto authored on 2010-05-02
292
    $sql_tmpl = $sql_tmpl->register_tag_processor($tag_processor);
many many changes
yuki-kimoto authored on 2010-04-30
293

            
some changed
yuki-kimoto authored on 2010-05-02
294
The following is register_tag_processor sample
many many changes
yuki-kimoto authored on 2010-04-30
295

            
some changed
yuki-kimoto authored on 2010-05-02
296
    $sql_tmpl->register_tag_processor(
many many changes
yuki-kimoto authored on 2010-04-30
297
        '?' => sub {
298
            my ($tag_name, $tag_args) = @_;
299
            
300
            my $key1 = $tag_args->[0];
301
            my $key2 = $tag_args->[1];
302
            
303
            my $key_infos = [];
304
            
305
            # Expand tag and create key informations
306
            
307
            # Return expand tags and key informations
308
            return ($expand, $key_infos);
309
        }
310
    );
311

            
312
Tag processor recieve 2 argument
313

            
314
    1. Tag name            (?, =, <>, or etc)
315
    2. Tag arguments       (arg1 and arg2 in {tag_name arg1 arg2})
316

            
317
Tag processor return 2 value
318

            
319
    1. Expanded Tag (For exsample, '{= title}' is expanded to 'title = ?')
320
    2. Key infomations
321
    
322
You must be return expanded tag and key infomations.
323

            
324
Key information is a little complex. so I will explan this in future.
325

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

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
328
=head2 C<clone>
many many changes
yuki-kimoto authored on 2010-04-30
329

            
330
Clone DBIx::Custom::SQLTemplate object
331

            
332
    $clone = $sql_tmpl->clone;
333
    
334
=head1 Available Tags
335
    
336
Available Tags
337

            
338
    [tag]            [expand]
339
    {? name}         ?
340
    {= name}         name = ?
341
    {<> name}        name <> ?
342
    
343
    {< name}         name < ?
344
    {> name}         name > ?
345
    {>= name}        name >= ?
346
    {<= name}        name <= ?
347
    
348
    {like name}      name like ?
349
    {in name}        name in [?, ?, ..]
350
    
351
    {insert}         (key1, key2, key3) values (?, ?, ?)
352
    {update}         set key1 = ?, key2 = ?, key3 = ?
353
    
354

            
355
The following is insert SQL sample
356

            
357
    $query = $sql_tmpl->create_sql(
358
        "insert into table {insert key1 key2}"
359
    );
360
    
361
    # Expanded
362
    $query->sql : "insert into table (key1, key2) values (?, ?)"
363

            
364
The following is update SQL sample
365
    
366
    $query = $sql_tmpl->create_sql(
367
        "update table {update key1 key2} where {= key3}"
368
    );
369
    
370
    # Expanded
371
    $query->sql : "update table set key1 = ?, key2 = ? where key3 = ?;"
372
    
373
=cut
374