Newer Older
696 lines | 18.624kb
packing
yuki-kimoto authored on 2009-11-12
1
package DBIx::Custom::SQL::Template;
2
use Object::Simple;
3

            
4
our $VERSION = '0.0101';
5

            
6
use Carp 'croak';
7

            
8
# Accessor is created by Object::Simple. Please read Object::Simple document
9

            
10
### Class-Object accessors
11

            
12
# Tag start
13
sub tag_start   : ClassObjectAttr {
14
    initialize => {default => '{', clone => 'scalar'}
15
}
16

            
17
# Tag end
18
sub tag_end     : ClassObjectAttr {
19
    initialize => {default => '}', clone => 'scalar'}
20
}
21

            
22
# Tag syntax
23
sub tag_syntax  : ClassObjectAttr {
24
    initialize => {default => <<'EOS', clone => 'scalar'}}
25
[tag]                     [expand]
26
{? name}                  ?
27
{= name}                  name = ?
28
{<> name}                 name <> ?
29

            
30
{< name}                  name < ?
31
{> name}                  name > ?
32
{>= name}                 name >= ?
33
{<= name}                 name <= ?
34

            
35
{like name}               name like ?
36
{in name number}          name in [?, ?, ..]
37

            
38
{insert key1 key2} (key1, key2) values (?, ?)
39
{update key1 key2}    set key1 = ?, key2 = ?
40
EOS
41

            
42
# Tag processors
43
sub tag_processors : ClassObjectAttr {
44
    type => 'hash',
45
    deref => 1,
46
    initialize => {
47
        clone => 'hash', 
48
        default => sub {{
49
            '?'             => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
50
            '='             => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
51
            '<>'            => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
52
            '>'             => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
53
            '<'             => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
54
            '>='            => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
55
            '<='            => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
56
            'like'          => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
57
            'in'            => \&DBIx::Custom::SQL::Template::TagProcessor::expand_in_tag,
58
            'insert'        => \&DBIx::Custom::SQL::Template::TagProcessor::expand_insert_tag,
59
            'update'    => \&DBIx::Custom::SQL::Template::TagProcessor::expand_update_tag
60
        }}
61
    }
62
}
63

            
64
# Add Tag processor
65
sub add_tag_processor {
66
    my $invocant = shift;
67
    my $tag_processors = ref $_[0] eq 'HASH' ? $_[0] : {@_};
68
    $invocant->tag_processors(%{$invocant->tag_processors}, %{$tag_processors});
69
    return $invocant;
70
}
71

            
72
# Clone
73
sub clone {
74
    my $self = shift;
75
    my $new = $self->new;
76
    
77
    $new->tag_start($self->tag_start);
78
    $new->tag_end($self->tag_end);
79
    $new->tag_syntax($self->tag_syntax);
80
    $new->tag_processors({%{$self->tag_processors || {}}});
81
    
82
    return $new;
83
}
84

            
85

            
86
### Object Methods
87

            
88
# Create Query
89
sub create_query {
90
    my ($self, $template)  = @_;
91
    
92
    # Parse template
93
    my $tree = $self->_parse_template($template);
94
    
95
    # Build query
96
    my $query = $self->_build_query($tree);
97
    
98
    return $query;
99
}
100

            
101
# Parse template
102
sub _parse_template {
103
    my ($self, $template) = @_;
104
    $template ||= '';
105
    
106
    my $tree = [];
107
    
108
    # Tags
109
    my $tag_start = quotemeta $self->tag_start;
110
    my $tag_end   = quotemeta $self->tag_end;
111
    
112
    # Tokenize
113
    my $state = 'text';
114
    
115
    # Save original template
116
    my $original_template = $template;
117
    
118
    # Parse template
119
    while ($template =~ s/([^$tag_start]*?)$tag_start([^$tag_end].*?)$tag_end//sm) {
120
        my $text = $1;
121
        my $tag  = $2;
122
        
123
        # Parse tree
124
        push @$tree, {type => 'text', tag_args => [$text]} if $text;
125
        
126
        if ($tag) {
127
            # Get tag name and arguments
128
            my ($tag_name, @tag_args) = split /\s+/, $tag;
129
            
130
            # Tag processor is exist?
131
            unless ($self->tag_processors->{$tag_name}) {
132
                my $tag_syntax = $self->tag_syntax;
133
                croak("Tag '{$tag}' in SQL template is not exist.\n\n" .
134
                      "<SQL template tag syntax>\n" .
135
                      "$tag_syntax\n" .
136
                      "<Your SQL template>\n" .
137
                      "$original_template\n\n");
138
            }
139
            
140
            # Check tag arguments
141
            foreach my $tag_arg (@tag_args) {
142
                # Cannot cantain placehosder '?'
143
                croak("Tag '{t }' arguments cannot contain '?'")
144
                  if $tag_arg =~ /\?/;
145
            }
146
            
147
            # Add tag to parsing tree
148
            push @$tree, {type => 'tag', tag_name => $tag_name, tag_args => [@tag_args]};
149
        }
150
    }
151
    
152
    # Add text to parsing tree 
153
    push @$tree, {type => 'text', tag_args => [$template]} if $template;
154
    
155
    return $tree;
156
}
157

            
158
# Build SQL from parsing tree
159
sub _build_query {
160
    my ($self, $tree) = @_;
161
    
162
    # SQL
163
    my $sql = '';
164
    
165
    # All parameter key infomation
166
    my $all_key_infos = [];
167
    
168
    # Build SQL 
169
    foreach my $node (@$tree) {
170
        
171
        # Get type, tag name, and arguments
172
        my $type     = $node->{type};
173
        my $tag_name = $node->{tag_name};
174
        my $tag_args = $node->{tag_args};
175
        
176
        # Text
177
        if ($type eq 'text') {
178
            # Join text
179
            $sql .= $tag_args->[0];
180
        }
181
        
182
        # Tag
183
        elsif ($type eq 'tag') {
184
            
185
            # Get tag processor
186
            my $tag_processor = $self->tag_processors->{$tag_name};
187
            
188
            # Tag processor is code ref?
189
            croak("Tag processor '$tag_name' must be code reference")
190
              unless ref $tag_processor eq 'CODE';
191
            
192
            # Expand tag using tag processor
193
            my ($expand, $key_infos)
194
              = $tag_processor->($tag_name, $tag_args);
195
            
196
            # Check tag processor return value
197
            croak("Tag processor '$tag_name' must return (\$expand, \$key_infos)")
198
              if !defined $expand || ref $key_infos ne 'ARRAY';
199
            
200
            # Check placeholder count
201
            croak("Placeholder count in SQL created by tag processor '$tag_name' " .
202
                  "must be same as key informations count")
203
              unless $self->_placeholder_count($expand) eq @$key_infos;
204
            
205
            # Add key information
206
            push @$all_key_infos, @$key_infos;
207
            
208
            # Join expand tag to SQL
209
            $sql .= $expand;
210
        }
211
    }
212
    
213
    # Add semicolon
214
    $sql .= ';' unless $sql =~ /;$/;
215
    
216
    # Query
217
    my $query = {sql => $sql, key_infos => $all_key_infos};
218
    
219
    return $query;
220
}
221

            
222
# Get placeholder count
223
sub _placeholder_count {
224
    my ($self, $expand) = @_;
225
    $expand ||= '';
226
    
227
    my $count = 0;
228
    my $pos   = -1;
229
    while (($pos = index($expand, '?', $pos + 1)) != -1) {
230
        $count++;
231
    }
232
    return $count;
233
}
234

            
235
Object::Simple->build_class;
236

            
237

            
238
package DBIx::Custom::SQL::Template::TagProcessor;
239
use strict;
240
use warnings;
241
use Carp 'croak';
242

            
243
# Expand tag '?', '=', '<>', '>', '<', '>=', '<=', 'like'
244
sub expand_basic_tag {
245
    my ($tag_name, $tag_args) = @_;
246
    my $original_key = $tag_args->[0];
247
    
248
    # Key is not exist
249
    croak("You must be pass key as argument to tag '{$tag_name }'")
250
      if !$original_key;
251
    
252
    # Expanded tag
253
    my $expand = $tag_name eq '?'
254
               ? '?'
255
               : "$original_key $tag_name ?";
256
    
257
    # Get table and clumn name
258
    my ($table, $column) = get_table_and_column($original_key);
259
    
260
    # Parameter key infomation
261
    my $key_info = {};
262
    
263
    # Original key
264
    $key_info->{original_key} = $original_key;
265
    
266
    # Table
267
    $key_info->{table}  = $table;
268
    
269
    # Column name
270
    $key_info->{column} = $column;
271
    
272
    # Access keys
273
    my $access_keys = [];
274
    push @$access_keys, [$original_key];
275
    push @$access_keys, [$table, $column] if $table && $column;
276
    $key_info->{access_keys} = $access_keys;
277
    
278
    # Add parameter key information
279
    my $key_infos = [];
280
    push @$key_infos, $key_info;
281
    
282
    return ($expand, $key_infos);
283
}
284

            
285
# Expand tag 'in'
286
sub expand_in_tag {
287
    my ($tag_name, $tag_args) = @_;
288
    my ($original_key, $placeholder_count) = @$tag_args;
289
    
290
    # Key must be specified
291
    croak("You must be pass key as first argument of tag '{$tag_name }'\n" . 
292
          "Usage: {$tag_name \$key \$placeholder_count}")
293
      unless $original_key;
294
      
295
    
296
    # Place holder count must be specified
297
    croak("You must be pass placeholder count as second argument of tag '{$tag_name }'\n" . 
298
          "Usage: {$tag_name \$key \$placeholder_count}")
299
      if !$placeholder_count || $placeholder_count =~ /\D/;
300

            
301
    # Expand tag
302
    my $expand = "$original_key $tag_name (";
303
    for (my $i = 0; $i < $placeholder_count; $i++) {
304
        $expand .= '?, ';
305
    }
306
    
307
    $expand =~ s/, $//;
308
    $expand .= ')';
309
    
310
    # Get table and clumn name
311
    my ($table, $column) = get_table_and_column($original_key);
312
    
313
    # Create parameter key infomations
314
    my $key_infos = [];
315
    for (my $i = 0; $i < $placeholder_count; $i++) {
316
        # Parameter key infomation
317
        my $key_info = {};
318
        
319
        # Original key
320
        $key_info->{original_key} = $original_key;
321
        
322
        # Table
323
        $key_info->{table}   = $table;
324
        
325
        # Column name
326
        $key_info->{column}  = $column;
327
        
328
        # Access keys
329
        my $access_keys = [];
330
        push @$access_keys, [$original_key, [$i]];
331
        push @$access_keys, [$table, $column, [$i]] if $table && $column;
332
        $key_info->{access_keys} = $access_keys;
333
        
334
        # Add parameter key infos
335
        push @$key_infos, $key_info;
336
    }
337
    
338
    return ($expand, $key_infos);
339
}
340

            
341
# Get table and column
342
sub get_table_and_column {
343
    my $key = shift;
344
    $key ||= '';
345
    
346
    return ('', $key) unless $key =~ /\./;
347
    
348
    my ($table, $column) = split /\./, $key;
349
    
350
    return ($table, $column);
351
}
352

            
353
# Expand tag 'insert'
354
sub expand_insert_tag {
355
    my ($tag_name, $tag_args) = @_;
356
    my $original_keys = $tag_args;
357
    
358
    # Insert key (k1, k2, k3, ..)
359
    my $insert_keys = '(';
360
    
361
    # placeholder (?, ?, ?, ..)
362
    my $place_holders = '(';
363
    
364
    foreach my $original_key (@$original_keys) {
365
        # Get table and column
366
        my ($table, $column) = get_table_and_column($original_key);
367
        
368
        # Join insert column
369
        $insert_keys   .= "$column, ";
370
        
371
        # Join place holder
372
        $place_holders .= "?, ";
373
    }
374
    
375
    # Delete last ', '
376
    $insert_keys =~ s/, $//;
377
    
378
    # Close 
379
    $insert_keys .= ')';
380
    $place_holders =~ s/, $//;
381
    $place_holders .= ')';
382
    
383
    # Expand tag
384
    my $expand = "$insert_keys values $place_holders";
385
    
386
    # Create parameter key infomations
387
    my $key_infos = [];
388
    foreach my $original_key (@$original_keys) {
389
        # Get table and clumn name
390
        my ($table, $column) = get_table_and_column($original_key);
391
        
392
        # Parameter key infomation
393
        my $key_info = {};
394
        
395
        # Original key
396
        $key_info->{original_key} = $original_key;
397
        
398
        # Table
399
        $key_info->{table}   = $table;
400
        
401
        # Column name
402
        $key_info->{column}  = $column;
403
        
404
        # Access keys
405
        my $access_keys = [];
406
        push @$access_keys, ['#insert', $original_key];
407
        push @$access_keys, ['#insert', $table, $column] if $table && $column;
408
        push @$access_keys, [$original_key];
409
        push @$access_keys, [$table, $column] if $table && $column;
410
        $key_info->{access_keys} = $access_keys;
411
        
412
        # Add parameter key infos
413
        push @$key_infos, $key_info;
414
    }
415
    
416
    return ($expand, $key_infos);
417
}
418

            
419
# Expand tag 'update'
420
sub expand_update_tag {
421
    my ($tag_name, $tag_args) = @_;
422
    my $original_keys = $tag_args;
423
    
424
    # Expanded tag
425
    my $expand = 'set ';
426
    
427
    # 
428
    foreach my $original_key (@$original_keys) {
429
        # Get table and clumn name
430
        my ($table, $column) = get_table_and_column($original_key);
431

            
432
        # Join key and placeholder
433
        $expand .= "$column = ?, ";
434
    }
435
    
436
    # Delete last ', '
437
    $expand =~ s/, $//;
438
    
439
    # Create parameter key infomations
440
    my $key_infos = [];
441
    foreach my $original_key (@$original_keys) {
442
        # Get table and clumn name
443
        my ($table, $column) = get_table_and_column($original_key);
444
        
445
        # Parameter key infomation
446
        my $key_info = {};
447
        
448
        # Original key
449
        $key_info->{original_key} = $original_key;
450
        
451
        # Table
452
        $key_info->{table}  = $table;
453
        
454
        # Column name
455
        $key_info->{column} = $column;
456
        
457
        # Access keys
458
        my $access_keys = [];
459
        push @$access_keys, ['#update', $original_key];
460
        push @$access_keys, ['#update', $table, $column] if $table && $column;
461
        push @$access_keys, [$original_key];
462
        push @$access_keys, [$table, $column] if $table && $column;
463
        $key_info->{access_keys} = $access_keys;
464
        
465
        # Add parameter key infos
466
        push @$key_infos, $key_info;
467
    }
468
    
469
    return ($expand, $key_infos);
470
}
471

            
472
1;
473

            
474
=head1 NAME
475

            
476
DBIx::Custom::SQL::Template - Custamizable SQL Template for DBIx::Custom
477

            
478
=head1 VERSION
479

            
480
Version 0.0101
481

            
482
=cut
483

            
484
=head1 SYNOPSIS
485
    
486
    my $sql_tmpl = DBIx::Custom::SQL::Template->new;
487
    
488
    my $tmpl   = "select from table {= k1} && {<> k2} || {like k3}";
489
    my $param = {k1 => 1, k2 => 2, k3 => 3};
490
    
491
    my $query = $sql_template->create_query($tmpl);
492
    
493
    
494
    # Using query from DBIx::Custom
495
    use DBIx::Custom;
496
    my $dbi = DBI->new(
497
       data_source => $data_source,
498
       user        => $user,
499
       password    => $password, 
500
       dbi_options => {PrintError => 0, RaiseError => 1}
501
    );
502
    
503
    $query = $dbi->create_query($tmpl); # This is SQL::Template create_query
504
    $dbi->query($query, $param);
505

            
506
=head1 CLASS-OBJECT ACCESSORS
507

            
508
Class-Object accessor is used from both object and class
509

            
510
    $class->$accessor # call from class
511
    $self->$accessor  # call form object
512

            
513
=head2 tag_processors
514

            
515
    # Set and get
516
    $self           = $sql_tmpl->tag_processors($tag_processors);
517
    $tag_processors = $sql_tmpl->tag_processors;
518
    
519
    # Sample
520
    $sql_tmpl->tag_processors(
521
        '?' => \&expand_question,
522
        '=' => \&expand_equel
523
    );
524

            
525
You can use add_tag_processor to add tag processor
526

            
527
=head2 tag_start
528

            
529
    # Set and get
530
    $self      = $sql_tmpl->tag_start($tag_start);
531
    $tag_start = $sql_tmpl->tag_start;
532
    
533
    # Sample
534
    $sql_tmpl->tag_start('{');
535

            
536
Default is '{'
537

            
538
=head2 tag_end
539

            
540
    # Set and get
541
    $self    = $sql_tmpl->tag_start($tag_end);
542
    $tag_end = $sql_tmpl->tag_start;
543
    
544
    # Sample
545
    $sql_tmpl->tag_start('}');
546

            
547
Default is '}'
548
    
549
=head2 tag_syntax
550
    
551
    # Set and get
552
    $self       = $sql_tmpl->tag_syntax($tag_syntax);
553
    $tag_syntax = $sql_tmpl->tag_syntax;
554
    
555
    # Sample
556
    $sql_tmpl->tag_syntax(
557
        "[Tag]            [Expand]\n" .
558
        "{? name}         ?\n" .
559
        "{= name}         name = ?\n" .
560
        "{<> name}        name <> ?\n"
561
    );
562

            
563
=head1 METHODS
564

            
565
=head2 create_query
566
    
567
    # Create SQL form SQL template
568
    $query = $sql_tmpl->create_query($tmpl);
569
    
570
    # Sample
571
    $query = $sql_tmpl->create_sql(
572
         "select * from table where {= title} && {like author} || {<= price}")
573
    
574
    # Result
575
    $qeury->{sql} : "select * from table where title = ? && author like ? price <= ?;"
576
    $query->{key_infos} : [['title'], ['author'], ['price']]
577
    
578
    # Sample2 (with table name)
579
    ($sql, @bind_values) = $sql_tmpl->create_sql(
580
            "select * from table where {= table.title} && {like table.author}",
581
            {table => {title => 'Perl', author => '%Taro%'}}
582
        )
583
    
584
    # Result2
585
    $query->{sql} : "select * from table where table.title = ? && table.title like ?;"
586
    $query->{key_infos} :[ [['table.title'],['table', 'title']],
587
                           [['table.author'],['table', 'author']] ]
588

            
589
This method create query using by DBIx::Custom.
590
query is two infomation
591

            
592
    1.sql       : SQL
593
    2.key_infos : Parameter access key information
594

            
595
=head2 add_tag_processor
596

            
597
Add tag processor
598
  
599
    # Add
600
    $self = $sql_tmpl->add_tag_processor($tag_processor);
601
    
602
    # Sample
603
    $sql_tmpl->add_tag_processor(
604
        '?' => sub {
605
            my ($tag_name, $tag_args) = @_;
606
            
607
            my $key1 = $tag_args->[0];
608
            my $key2 = $tag_args->[1];
609
            
610
            my $key_infos = [];
611
            
612
            # Expand tag and create key informations
613
            
614
            # Return expand tags and key informations
615
            return ($expand, $key_infos);
616
        }
617
    );
618

            
619
Tag processor recieve 2 argument
620

            
621
    1. Tag name            (?, =, <>, or etc)
622
    2. Tag arguments       (arg1 and arg2 in {tag_name arg1 arg2})
623

            
624
Tag processor return 2 value
625

            
626
    1. Expanded Tag (For exsample, '{= title}' is expanded to 'title = ?')
627
    2. Key infomations
628
    
629
You must be return expanded tag and key infomations.
630

            
631
Key information is a little complex. so I will explan this in future.
632

            
633
If you want to know more, Please see DBIx::Custom::SQL::Template source code.
634

            
635
=head2 clone
636

            
637
    # Clone DBIx::Custom::SQL::Template object
638
    $clone = $self->clone;
639
    
640
=head1 Available Tags
641
    
642
    # Available Tags
643
    [tag]            [expand]
644
    {? name}         ?
645
    {= name}         name = ?
646
    {<> name}        name <> ?
647
    
648
    {< name}         name < ?
649
    {> name}         name > ?
650
    {>= name}        name >= ?
651
    {<= name}        name <= ?
652
    
653
    {like name}      name like ?
654
    {in name}        name in [?, ?, ..]
655
    
656
    {insert}  (key1, key2, key3) values (?, ?, ?)
657
    {update}     set key1 = ?, key2 = ?, key3 = ?
658
    
659
    # Sample1
660
    $query = $sql_tmpl->create_sql(
661
        "insert into table {insert key1 key2}"
662
    );
663
    # Result1
664
    $sql : "insert into table (key1, key2) values (?, ?)"
665
    
666
    
667
    # Sample2
668
    $query = $sql_tmpl->create_sql(
669
        "update table {update key1 key2} where {= key3}"
670
    );
671
    
672
    # Result2
673
    $query->{sql} : "update table set key1 = ?, key2 = ? where key3 = ?;"
674
    
675
=head1 AUTHOR
676

            
677
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
678

            
679
Github 
680
L<http://github.com/yuki-kimoto>
681
L<http://github.com/yuki-kimoto/DBIx-Custom-SQL-Template>
682

            
683
Please let know me bag if you find
684
Please request me if you want to do something
685

            
686
=head1 COPYRIGHT & LICENSE
687

            
688
Copyright 2009 Yuki Kimoto, all rights reserved.
689

            
690
This program is free software; you can redistribute it and/or modify it
691
under the same terms as Perl itself.
692

            
693

            
694
=cut
695

            
696
1; # End of DBIx::Custom::SQL::Template