package DBIx::Custom::SQL::Template;

use Object::Simple;

use Carp 'croak';

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

### Class-Object accessors

# Tag start

sub tag_start   : ClassObjectAttr {

    initialize => {default => '{', clone => 'scalar'}

}

# Tag end

sub tag_end     : ClassObjectAttr {

    initialize => {default => '}', clone => 'scalar'}

}

# Tag syntax

sub tag_syntax  : ClassObjectAttr {

    initialize => {default => <<'EOS', clone => 'scalar'}}

[tag]                     [expand]

{? name}                  ?

{= name}                  name = ?

{<> name}                 name <> ?

{< name}                  name < ?

{> name}                  name > ?

{>= name}                 name >= ?

{<= name}                 name <= ?

{like name}               name like ?

{in name number}          name in [?, ?, ..]

{insert key1 key2} (key1, key2) values (?, ?)

{update key1 key2}    set key1 = ?, key2 = ?

EOS

# Tag processors

sub tag_processors : ClassObjectAttr {

    type => 'hash',

    deref => 1,

    initialize => {

        clone => 'hash', 

        default => sub {{

            '?'             => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,

            '='             => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,

            '<>'            => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,

            '>'             => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,

            '<'             => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,

            '>='            => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,

            '<='            => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,

            'like'          => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,

            'in'            => \&DBIx::Custom::SQL::Template::TagProcessor::expand_in_tag,

            'insert'        => \&DBIx::Custom::SQL::Template::TagProcessor::expand_insert_tag,

            'update'    => \&DBIx::Custom::SQL::Template::TagProcessor::expand_update_tag

        }}

    }

}

# Add Tag processor

sub add_tag_processor {

    my $invocant = shift;

    my $tag_processors = ref $_[0] eq 'HASH' ? $_[0] : {@_};

    $invocant->tag_processors(%{$invocant->tag_processors}, %{$tag_processors});

    return $invocant;

}

# Clone

sub clone {

    my $self = shift;

    my $new = $self->new;

    $new->tag_start($self->tag_start);

    $new->tag_end($self->tag_end);

    $new->tag_syntax($self->tag_syntax);

    $new->tag_processors({%{$self->tag_processors || {}}});

    return $new;

}

### Object Methods

# Create Query

sub create_query {

    my ($self, $template)  = @_;

    # Parse template

    my $tree = $self->_parse_template($template);

    # Build query

    my $query = $self->_build_query($tree);

    return $query;

}

# Parse template

sub _parse_template {

    my ($self, $template) = @_;

    $template ||= '';

    my $tree = [];

    # Tags

    my $tag_start = quotemeta $self->tag_start;

    my $tag_end   = quotemeta $self->tag_end;

    # Tokenize

    my $state = 'text';

    # Save original template

    my $original_template = $template;

    # Parse template

    while ($template =~ s/([^$tag_start]*?)$tag_start([^$tag_end].*?)$tag_end//sm) {

        my $text = $1;

        my $tag  = $2;

        # Parse tree

        push @$tree, {type => 'text', tag_args => [$text]} if $text;

        if ($tag) {

            # Get tag name and arguments

            my ($tag_name, @tag_args) = split /\s+/, $tag;

            # Tag processor is exist?

            unless ($self->tag_processors->{$tag_name}) {

                my $tag_syntax = $self->tag_syntax;

                croak("Tag '{$tag}' in SQL template is not exist.\n\n" .

                      "<SQL template tag syntax>\n" .

                      "$tag_syntax\n" .

                      "<Your SQL template>\n" .

                      "$original_template\n\n");

            }

            # Check tag arguments

            foreach my $tag_arg (@tag_args) {

                # Cannot cantain placehosder '?'

                croak("Tag '{t }' arguments cannot contain '?'")

                  if $tag_arg =~ /\?/;

            }

            # Add tag to parsing tree

            push @$tree, {type => 'tag', tag_name => $tag_name, tag_args => [@tag_args]};

        }

    }

    # Add text to parsing tree 

    push @$tree, {type => 'text', tag_args => [$template]} if $template;

    return $tree;

}

# Build SQL from parsing tree

sub _build_query {

    my ($self, $tree) = @_;

    # SQL

    my $sql = '';

    # All parameter key infomation

    my $all_key_infos = [];

    # Build SQL 

    foreach my $node (@$tree) {

        # Get type, tag name, and arguments

        my $type     = $node->{type};

        my $tag_name = $node->{tag_name};

        my $tag_args = $node->{tag_args};

        # Text

        if ($type eq 'text') {

            # Join text

            $sql .= $tag_args->[0];

        }

        # Tag

        elsif ($type eq 'tag') {

            # Get tag processor

            my $tag_processor = $self->tag_processors->{$tag_name};

            # Tag processor is code ref?

            croak("Tag processor '$tag_name' must be code reference")

              unless ref $tag_processor eq 'CODE';

            # Expand tag using tag processor

            my ($expand, $key_infos)

              = $tag_processor->($tag_name, $tag_args);

            # Check tag processor return value

            croak("Tag processor '$tag_name' must return (\$expand, \$key_infos)")

              if !defined $expand || ref $key_infos ne 'ARRAY';

            # Check placeholder count

            croak("Placeholder count in SQL created by tag processor '$tag_name' " .

                  "must be same as key informations count")

              unless $self->_placeholder_count($expand) eq @$key_infos;

            # Add key information

            push @$all_key_infos, @$key_infos;

            # Join expand tag to SQL

            $sql .= $expand;

        }

    }

    # Add semicolon

    $sql .= ';' unless $sql =~ /;$/;

    # Query

    my $query = {sql => $sql, key_infos => $all_key_infos};

    return $query;

}

# Get placeholder count

sub _placeholder_count {

    my ($self, $expand) = @_;

    $expand ||= '';

    my $count = 0;

    my $pos   = -1;

    while (($pos = index($expand, '?', $pos + 1)) != -1) {

        $count++;

    }

    return $count;

}

Object::Simple->build_class;

package DBIx::Custom::SQL::Template::TagProcessor;

use strict;

use warnings;

use Carp 'croak';

# Expand tag '?', '=', '<>', '>', '<', '>=', '<=', 'like'

sub expand_basic_tag {

    my ($tag_name, $tag_args) = @_;

    my $original_key = $tag_args->[0];

    # Key is not exist

    croak("You must be pass key as argument to tag '{$tag_name }'")

      if !$original_key;

    # Expanded tag

    my $expand = $tag_name eq '?'

               ? '?'

               : "$original_key $tag_name ?";

    # Get table and clumn name

    my ($table, $column) = get_table_and_column($original_key);

    # Parameter key infomation

    my $key_info = {};

    # Original key

    $key_info->{original_key} = $original_key;

    # Table

    $key_info->{table}  = $table;

    # Column name

    $key_info->{column} = $column;

    # Access keys

    my $access_keys = [];

    push @$access_keys, [$original_key];

    push @$access_keys, [$table, $column] if $table && $column;

    $key_info->{access_keys} = $access_keys;

    # Add parameter key information

    my $key_infos = [];

    push @$key_infos, $key_info;

    return ($expand, $key_infos);

}

# Expand tag 'in'

sub expand_in_tag {

    my ($tag_name, $tag_args) = @_;

    my ($original_key, $placeholder_count) = @$tag_args;

    # Key must be specified

    croak("You must be pass key as first argument of tag '{$tag_name }'\n" . 

          "Usage: {$tag_name \$key \$placeholder_count}")

      unless $original_key;

    # Place holder count must be specified

    croak("You must be pass placeholder count as second argument of tag '{$tag_name }'\n" . 

          "Usage: {$tag_name \$key \$placeholder_count}")

      if !$placeholder_count || $placeholder_count =~ /\D/;

    # Expand tag

    my $expand = "$original_key $tag_name (";

    for (my $i = 0; $i < $placeholder_count; $i++) {

        $expand .= '?, ';

    }

    $expand =~ s/, $//;

    $expand .= ')';

    # Get table and clumn name

    my ($table, $column) = get_table_and_column($original_key);

    # Create parameter key infomations

    my $key_infos = [];

    for (my $i = 0; $i < $placeholder_count; $i++) {

        # Parameter key infomation

        my $key_info = {};

        # Original key

        $key_info->{original_key} = $original_key;

        # Table

        $key_info->{table}   = $table;

        # Column name

        $key_info->{column}  = $column;

        # Access keys

        my $access_keys = [];

        push @$access_keys, [$original_key, [$i]];

        push @$access_keys, [$table, $column, [$i]] if $table && $column;

        $key_info->{access_keys} = $access_keys;

        # Add parameter key infos

        push @$key_infos, $key_info;

    }

    return ($expand, $key_infos);

}

# Get table and column

sub get_table_and_column {

    my $key = shift;

    $key ||= '';

    return ('', $key) unless $key =~ /\./;

    my ($table, $column) = split /\./, $key;

    return ($table, $column);

}

# Expand tag 'insert'

sub expand_insert_tag {

    my ($tag_name, $tag_args) = @_;

    my $original_keys = $tag_args;

    # Insert key (k1, k2, k3, ..)

    my $insert_keys = '(';

    # placeholder (?, ?, ?, ..)

    my $place_holders = '(';

    foreach my $original_key (@$original_keys) {

        # Get table and column

        my ($table, $column) = get_table_and_column($original_key);

        # Join insert column

        $insert_keys   .= "$column, ";

        # Join place holder

        $place_holders .= "?, ";

    }

    # Delete last ', '

    $insert_keys =~ s/, $//;

    # Close 

    $insert_keys .= ')';

    $place_holders =~ s/, $//;

    $place_holders .= ')';

    # Expand tag

    my $expand = "$insert_keys values $place_holders";

    # Create parameter key infomations

    my $key_infos = [];

    foreach my $original_key (@$original_keys) {

        # Get table and clumn name

        my ($table, $column) = get_table_and_column($original_key);

        # Parameter key infomation

        my $key_info = {};

        # Original key

        $key_info->{original_key} = $original_key;

        # Table

        $key_info->{table}   = $table;

        # Column name

        $key_info->{column}  = $column;

        # Access keys

        my $access_keys = [];

        push @$access_keys, ['#insert', $original_key];

        push @$access_keys, ['#insert', $table, $column] if $table && $column;

        push @$access_keys, [$original_key];

        push @$access_keys, [$table, $column] if $table && $column;

        $key_info->{access_keys} = $access_keys;

        # Add parameter key infos

        push @$key_infos, $key_info;

    }

    return ($expand, $key_infos);

}

# Expand tag 'update'

sub expand_update_tag {

    my ($tag_name, $tag_args) = @_;

    my $original_keys = $tag_args;

    # Expanded tag

    my $expand = 'set ';

    # 

    foreach my $original_key (@$original_keys) {

        # Get table and clumn name

        my ($table, $column) = get_table_and_column($original_key);

        # Join key and placeholder

        $expand .= "$column = ?, ";

    }

    # Delete last ', '

    $expand =~ s/, $//;

    # Create parameter key infomations

    my $key_infos = [];

    foreach my $original_key (@$original_keys) {

        # Get table and clumn name

        my ($table, $column) = get_table_and_column($original_key);

        # Parameter key infomation

        my $key_info = {};

        # Original key

        $key_info->{original_key} = $original_key;

        # Table

        $key_info->{table}  = $table;

        # Column name

        $key_info->{column} = $column;

        # Access keys

        my $access_keys = [];

        push @$access_keys, ['#update', $original_key];

        push @$access_keys, ['#update', $table, $column] if $table && $column;

        push @$access_keys, [$original_key];

        push @$access_keys, [$table, $column] if $table && $column;

        $key_info->{access_keys} = $access_keys;

        # Add parameter key infos

        push @$key_infos, $key_info;

    }

    return ($expand, $key_infos);

}

1;

=head1 NAME

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

=head1 VERSION

Version 0.0101

=cut

=head1 SYNOPSIS

    my $sql_tmpl = DBIx::Custom::SQL::Template->new;

    my $tmpl   = "select from table {= k1} && {<> k2} || {like k3}";

    my $param = {k1 => 1, k2 => 2, k3 => 3};

    my $query = $sql_template->create_query($tmpl);

    # Using query from DBIx::Custom

    use DBIx::Custom;

    my $dbi = DBI->new(

       data_source => $data_source,

       user        => $user,

       password    => $password, 

       dbi_options => {PrintError => 0, RaiseError => 1}

    );

    $query = $dbi->create_query($tmpl); # This is SQL::Template create_query

    $dbi->query($query, $param);

=head1 CLASS-OBJECT ACCESSORS

Class-Object accessor is used from both object and class

    $class->$accessor # call from class

    $self->$accessor  # call form object

=head2 tag_processors

    # Set and get

    $self           = $sql_tmpl->tag_processors($tag_processors);

    $tag_processors = $sql_tmpl->tag_processors;

    # Sample

    $sql_tmpl->tag_processors(

        '?' => \&expand_question,

        '=' => \&expand_equel

    );

You can use add_tag_processor to add tag processor

=head2 tag_start

    # Set and get

    $self      = $sql_tmpl->tag_start($tag_start);

    $tag_start = $sql_tmpl->tag_start;

    # Sample

    $sql_tmpl->tag_start('{');

Default is '{'

=head2 tag_end

    # Set and get

    $self    = $sql_tmpl->tag_start($tag_end);

    $tag_end = $sql_tmpl->tag_start;

    # Sample

    $sql_tmpl->tag_start('}');

Default is '}'

=head2 tag_syntax

    # Set and get

    $self       = $sql_tmpl->tag_syntax($tag_syntax);

    $tag_syntax = $sql_tmpl->tag_syntax;

    # Sample

    $sql_tmpl->tag_syntax(

        "[Tag]            [Expand]\n" .

        "{? name}         ?\n" .

        "{= name}         name = ?\n" .

        "{<> name}        name <> ?\n"

    );

=head1 METHODS

=head2 create_query

    # Create SQL form SQL template

    $query = $sql_tmpl->create_query($tmpl);

    # Sample

    $query = $sql_tmpl->create_sql(

         "select * from table where {= title} && {like author} || {<= price}")

    # Result

    $qeury->{sql} : "select * from table where title = ? && author like ? price <= ?;"

    $query->{key_infos} : [['title'], ['author'], ['price']]

    # Sample2 (with table name)

    ($sql, @bind_values) = $sql_tmpl->create_sql(

            "select * from table where {= table.title} && {like table.author}",

            {table => {title => 'Perl', author => '%Taro%'}}

        )

    # Result2

    $query->{sql} : "select * from table where table.title = ? && table.title like ?;"

    $query->{key_infos} :[ [['table.title'],['table', 'title']],

                           [['table.author'],['table', 'author']] ]

This method create query using by DBIx::Custom.

query is two infomation

    1.sql       : SQL

    2.key_infos : Parameter access key information

=head2 add_tag_processor

Add tag processor

    # Add

    $self = $sql_tmpl->add_tag_processor($tag_processor);

    # Sample

    $sql_tmpl->add_tag_processor(

        '?' => sub {

            my ($tag_name, $tag_args) = @_;

            my $key1 = $tag_args->[0];

            my $key2 = $tag_args->[1];

            my $key_infos = [];

            # Expand tag and create key informations

            # Return expand tags and key informations

            return ($expand, $key_infos);

        }

    );

Tag processor recieve 2 argument

    1. Tag name            (?, =, <>, or etc)

    2. Tag arguments       (arg1 and arg2 in {tag_name arg1 arg2})

Tag processor return 2 value

    1. Expanded Tag (For exsample, '{= title}' is expanded to 'title = ?')

    2. Key infomations

You must be return expanded tag and key infomations.

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

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

=head2 clone

    # Clone DBIx::Custom::SQL::Template object

    $clone = $self->clone;

=head1 Available Tags

    # Available Tags

    [tag]            [expand]

    {? name}         ?

    {= name}         name = ?

    {<> name}        name <> ?

    {< name}         name < ?

    {> name}         name > ?

    {>= name}        name >= ?

    {<= name}        name <= ?

    {like name}      name like ?

    {in name}        name in [?, ?, ..]

    {insert}  (key1, key2, key3) values (?, ?, ?)

    {update}     set key1 = ?, key2 = ?, key3 = ?

    # Sample1

    $query = $sql_tmpl->create_sql(

        "insert into table {insert key1 key2}"

    );

    # Result1

    $sql : "insert into table (key1, key2) values (?, ?)"

    # Sample2

    $query = $sql_tmpl->create_sql(

        "update table {update key1 key2} where {= key3}"

    );

    # Result2

    $query->{sql} : "update table set key1 = ?, key2 = ? where key3 = ?;"

=head1 AUTHOR

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

Github 

L<http://github.com/yuki-kimoto>

L<http://github.com/yuki-kimoto/DBIx-Custom-SQL-Template>

Please let know me bag if you find

Please request me if you want to do something

=head1 COPYRIGHT & LICENSE

Copyright 2009 Yuki Kimoto, all rights reserved.

This program is free software; you can redistribute it and/or modify it

under the same terms as Perl itself.

=cut

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