try varioud way ・ e89e9b7 ・ Gitprep

+85 -2

lib/DBI/Custom.pm

@@ -95,8 +95,11 @@ sub create_sql {
 }
 
 sub query {
-    my $self = shift;
-    my ($sql, @bind) = $self->creqte_sql(@_);
+    my ($self, $template, $values, $filter)  = @_;
+    
+    $filter ||= $self->bind_filter;
+    
+    my ($sql, @bind) = $self->creqte_sql($template, $values, $filter);
     $self->prepare($sql);
     $self->execute(@bind);
 }
@@ -112,13 +115,93 @@ Object::Simple->build_class;
 package DBI::Custom::SQLTemplate;
 use Object::Simple;
 
+### Attributes;
+sub tag_start : Attr { default => '{' }
+sub tag_end   : Attr { default => '}' }
+sub template : Attr {};
+sub tree     : Attr { auto_build => sub { shift->tree([]) } }
+
+
 sub create_sql {
+    my ($self, $template, $values, $filter)  = @_;
+    
+    $self->parse($template);
+    
+    my ($sql, @bind);
+    
+    return ($sql, @bind);
+}
+
+our $TAG_SYNTAX = <<'EOS';
+[tag]            [expand]
+{= name}         name = ?
+{!= name}        name != ?
+
+{< name}         name < ?
+{> name}         name > ?
+{>= name}        name >= ?
+{<= name}        name <= ?
+
+{like name}      name like ?
+{in name}        name in [?, ?, ..]
+
+{insert_values}  (key1, key2, key3) values (?, ?, ?)
+{update_values}  set key1 = ?, key2 = ?, key3 = ?
+EOS
+
+our %VALID_TAG_NAMES = map {$_ => 1} qw/=/;
+sub parse {
+    my ($self, $template) = @_;
+    $self->template($template);
+    
+    # Clean start;
+    delete $self->{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;
+    
+    # Text
+    while ($template =~ s/([^$tag_start]*?)$tag_start([^$tag_end].*?)$tag_end//sm) {
+        my $text          = $1;
+        my $tag  = $2;
+        
+        push @{$self->tree}, ['text', $text] if $text;
+        
+        if ($tag) {
+            
+            my ($tag_name, @params) = split /\s+/, $tag;
+            
+            croak("Tag name is empty in '$tag'.\n" .
+                  "Tag Syntax\n$TAG_SYNTAX.\n" .
+                  "Your SQL template is \n$original_template")
+              unless length $tag_name;
+            
+            croak("Tag name '$tag_name' in '$tag' is invalid.\n" .
+                  "Tag Syntax\n$TAG_SYNTAX.\n" .
+                  "Your SQL template is \n$original_template")
+              unless $VALID_TAG_NAMES{$tag_name}; 
+            
+            push @{$self->tree}, [$tag_name, @params];
+        }
+    }
+    
+    push @{$self->tree}, ['text', $template] if $template;
 }
 
 
 
 
+
+
+
+
 Object::Simple->build_class;
 
 =head1 NAME

●	lib/DBI/Custom.pm	+85 -2
●	t/01-core.t	+10

...	...	@@ -95,8 +95,11 @@ sub create_sql {
95	95	}
96	96
97	97	sub query {
98		- my $self = shift;
99		- my ($sql, @bind) = $self->creqte_sql(@_);
	98	+ my ($self, $template, $values, $filter) = @_;
	99	+
	100	+ $filter \|\|= $self->bind_filter;
	101	+
	102	+ my ($sql, @bind) = $self->creqte_sql($template, $values, $filter);
100	103	$self->prepare($sql);
101	104	$self->execute(@bind);
102	105	}
...	...	@@ -112,13 +115,93 @@ Object::Simple->build_class;
112	115	package DBI::Custom::SQLTemplate;
113	116	use Object::Simple;
114	117
	118	+### Attributes;
	119	+sub tag_start : Attr { default => '{' }
	120	+sub tag_end : Attr { default => '}' }
	121	+sub template : Attr {};
	122	+sub tree : Attr { auto_build => sub { shift->tree([]) } }
	123	+
	124	+
115	125	sub create_sql {
	126	+ my ($self, $template, $values, $filter) = @_;
	127	+
	128	+ $self->parse($template);
	129	+
	130	+ my ($sql, @bind);
	131	+
	132	+ return ($sql, @bind);
	133	+}
	134	+
	135	+our $TAG_SYNTAX = <<'EOS';
	136	+[tag] [expand]
	137	+{= name} name = ?
	138	+{!= name} name != ?
	139	+
	140	+{< name} name < ?
	141	+{> name} name > ?
	142	+{>= name} name >= ?
	143	+{<= name} name <= ?
	144	+
	145	+{like name} name like ?
	146	+{in name} name in [?, ?, ..]
	147	+
	148	+{insert_values} (key1, key2, key3) values (?, ?, ?)
	149	+{update_values} set key1 = ?, key2 = ?, key3 = ?
	150	+EOS
	151	+
	152	+our %VALID_TAG_NAMES = map {$_ => 1} qw/=/;
	153	+sub parse {
	154	+ my ($self, $template) = @_;
	155	+ $self->template($template);
	156	+
	157	+ # Clean start;
	158	+ delete $self->{tree};
	159	+
	160	+ # Tags
	161	+ my $tag_start = quotemeta $self->tag_start;
	162	+ my $tag_end = quotemeta $self->tag_end;
116	163
	164	+ # Tokenize
	165	+ my $state = 'text';
	166	+
	167	+ # Save original template
	168	+ my $original_template = $template;
	169	+
	170	+ # Text
	171	+ while ($template =~ s/([^$tag_start]?)$tag_start([^$tag_end].?)$tag_end//sm) {
	172	+ my $text = $1;
	173	+ my $tag = $2;
	174	+
	175	+ push @{$self->tree}, ['text', $text] if $text;
	176	+
	177	+ if ($tag) {
	178	+
	179	+ my ($tag_name, @params) = split /\s+/, $tag;
	180	+
	181	+ croak("Tag name is empty in '$tag'.\n" .
	182	+ "Tag Syntax\n$TAG_SYNTAX.\n" .
	183	+ "Your SQL template is \n$original_template")
	184	+ unless length $tag_name;
	185	+
	186	+ croak("Tag name '$tag_name' in '$tag' is invalid.\n" .
	187	+ "Tag Syntax\n$TAG_SYNTAX.\n" .
	188	+ "Your SQL template is \n$original_template")
	189	+ unless $VALID_TAG_NAMES{$tag_name};
	190	+
	191	+ push @{$self->tree}, [$tag_name, @params];
	192	+ }
	193	+ }
	194	+
	195	+ push @{$self->tree}, ['text', $template] if $template;
117	196	}
118	197
119	198
120	199
121	200
	201	+
	202	+
	203	+
	204	+
122	205	Object::Simple->build_class;
123	206
124	207	=head1 NAME

...	...	@@ -172,6 +172,16 @@ our ($U, $P, $D) = connect_info();
172	172	like($@, qr/connect_info 'no_exist' is invald/, 'no exist');
173	173	}
174	174
	175	+{
	176	+ my $dbi = DBI::Custom->new;
	177	+ my $tmpl = "select * from table where {= title};";
	178	+ my $values = {title => 'a'};
	179	+ my ($sql, @bind) = $dbi->create_sql($tmpl, $values);
	180	+ is($sql, "select * from table where title = ?;");
	181	+ is_deeply(\@bind, ['a']);
	182	+
	183	+}
	184	+
175	185	sub connect_info {
176	186	my $file = 'password.tmp';
177	187	open my $fh, '<', $file