DBIx-Custom / lib / DBIx / Custom / QueryBuilder.pm /
Yuki Kimoto cleanup
0a037cc 13 years ago
2 contributor
311 lines | 8.594kb
  1. package DBIx::Custom::QueryBuilder;
  2.  
  3. use Object::Simple -base;
  4.  
  5. use Carp 'croak';
  6. use DBIx::Custom::Query;
  7. use DBIx::Custom::Util '_subname';
  8.  
  9. # Carp trust relationship
  10. push @DBIx::Custom::CARP_NOT, __PACKAGE__;
  11. push @DBIx::Custom::Where::CARP_NOT, __PACKAGE__;
  12.  
  13. has 'dbi';
  14.  
  15. sub build_query {
  16. my ($self, $source) = @_;
  17. my $query;
  18. # Parse tag. tag is DEPRECATED!
  19. if ($self->dbi->tag_parse && $source =~ /(\s|^)\{/) {
  20. $query = $self->_parse_tag($source);
  21. my $tag_count = delete $query->{tag_count};
  22. warn qq/Tag system such as {? name} is DEPRECATED! / .
  23. qq/use parameter system such as :name instead/
  24. if $tag_count;
  25. my $query2 = $self->_parse_parameter($query->sql);
  26. $query->sql($query2->sql);
  27. for (my $i =0; $i < @{$query->columns}; $i++) {
  28. my $column = $query->columns->[$i];
  29. if ($column eq 'RESERVED_PARAMETER') {
  30. my $column2 = shift @{$query2->columns};
  31. croak ":name syntax is wrong"
  32. unless defined $column2;
  33. $query->columns->[$i] = $column2;
  34. }
  35. }
  36. }
  37. # Parse parameter
  38. else { $query = $self->_parse_parameter($source) }
  39. my $sql = $query->sql;
  40. $query->sql($sql);
  41. return $query;
  42. }
  43.  
  44. sub _parse_parameter {
  45. my ($self, $source) = @_;
  46. # Get and replace parameters
  47. my $sql = $source || '';
  48. my $columns = [];
  49. my $c = $self->dbi->safety_character;
  50. # Parameter regex
  51. $sql =~ s/([^:]):(\d+):([^:])/$1\\:$2\\:$3/g;
  52. my $re = qr/(^|.*?[^\\]):([$c\.]+)(?:\{(.*?)\})?(.*)/s;
  53. while ($sql =~ /$re/g) {
  54. push @$columns, $2;
  55. $sql = defined $3 ? "$1$2 $3 ?$4" : "$1?$4";
  56. }
  57. $sql =~ s/\\:/:/g;
  58.  
  59. # Create query
  60. my $query = DBIx::Custom::Query->new(
  61. sql => $sql,
  62. columns => $columns
  63. );
  64. return $query;
  65. }
  66. # DEPRECATED!
  67. has tags => sub { {} };
  68.  
  69. # DEPRECATED!
  70. sub register_tag {
  71. my $self = shift;
  72. warn "register_tag is DEPRECATED!";
  73. # Merge tag
  74. my $tags = ref $_[0] eq 'HASH' ? $_[0] : {@_};
  75. $self->tags({%{$self->tags}, %$tags});
  76. return $self;
  77. }
  78.  
  79. # DEPRECATED!
  80. sub _parse_tag {
  81. my ($self, $source) = @_;
  82. # Source
  83. $source ||= '';
  84. # Tree
  85. my @tree;
  86. # Value
  87. my $value = '';
  88. # State
  89. my $state = 'text';
  90. # Before charactor
  91. my $before = '';
  92. # Position
  93. my $pos = 0;
  94. # Parse
  95. my $original = $source;
  96. my $tag_count = 0;
  97. while (defined(my $c = substr($source, $pos, 1))) {
  98. # Last
  99. last unless length $c;
  100. # Parameter
  101. if ($c eq ':' && (substr($source, $pos + 1, 1) || '') =~ /\w/) {
  102. push @tree, {type => 'param'};;
  103. }
  104. # State is text
  105. if ($state eq 'text') {
  106. # Tag start charactor
  107. if ($c eq '{') {
  108. # Escaped charactor
  109. if ($before eq "\\") {
  110. substr($value, -1, 1, '');
  111. $value .= $c;
  112. }
  113. # Tag start
  114. else {
  115. # Change state
  116. $state = 'tag';
  117. # Add text
  118. push @tree, {type => 'text', value => $value}
  119. if $value;
  120. # Clear
  121. $value = '';
  122. }
  123. }
  124. # Tag end charactor
  125. elsif ($c eq '}') {
  126. # Escaped charactor
  127. if ($before eq "\\") {
  128. substr($value, -1, 1, '');
  129. $value .= $c;
  130. }
  131. # Unexpected
  132. else {
  133. croak qq{Parsing error. unexpected "\}". }
  134. . qq{pos $pos of "$original" } . _subname
  135. }
  136. }
  137. # Normal charactor
  138. else { $value .= $c }
  139. }
  140. # State is tags
  141. else {
  142. # Tag start charactor
  143. if ($c eq '{') {
  144. # Escaped charactor
  145. if ($before eq "\\") {
  146. substr($value, -1, 1, '');
  147. $value .= $c;
  148. }
  149. # Unexpected
  150. else {
  151. croak qq{Parsing error. unexpected "\{". }
  152. . qq{pos $pos of "$original" } . _subname
  153. }
  154. }
  155. # Tag end charactor
  156. elsif ($c eq '}') {
  157. # Escaped charactor
  158. if ($before eq "\\") {
  159. substr($value, -1, 1, '');
  160. $value .= $c;
  161. }
  162. # Tag end
  163. else {
  164. # Change state
  165. $state = 'text';
  166. # Add tag
  167. my ($tag_name, @tag_args) = split /\s+/, $value;
  168. push @tree, {type => 'tag', tag_name => $tag_name,
  169. tag_args => \@tag_args};
  170. # Clear
  171. $value = '';
  172. # Countup
  173. $tag_count++;
  174. }
  175. }
  176. # Normal charactor
  177. else { $value .= $c }
  178. }
  179. # Save before charactor
  180. $before = $c;
  181. # increment position
  182. $pos++;
  183. }
  184. # Tag not finished
  185. croak qq{Tag not finished. "$original" } . _subname
  186. if $state eq 'tag';
  187. # Not contains tag
  188. return DBIx::Custom::Query->new(sql => $source, tag_count => $tag_count)
  189. if $tag_count == 0;
  190. # Add rest text
  191. push @tree, {type => 'text', value => $value}
  192. if $value;
  193. # SQL
  194. my $sql = '';
  195. # All Columns
  196. my $all_columns = [];
  197. # Tables
  198. my $tables = [];
  199. # Build SQL
  200. for my $node (@tree) {
  201. # Text
  202. if ($node->{type} eq 'text') { $sql .= $node->{value} }
  203. # Parameter
  204. elsif ($node->{type} eq 'param') {
  205. push @$all_columns, 'RESERVED_PARAMETER';
  206. }
  207. # Tag
  208. else {
  209. # Tag name
  210. my $tag_name = $node->{tag_name};
  211. # Tag arguments
  212. my $tag_args = $node->{tag_args};
  213. # Table
  214. if ($tag_name eq 'table') {
  215. my $table = $tag_args->[0];
  216. push @$tables, $table;
  217. $sql .= $table;
  218. next;
  219. }
  220. # Get tag
  221. $self->dbi->{_tags} ||= {};
  222. my $tag = $self->tag_processors->{$tag_name}
  223. || $self->dbi->{_tags}->{$tag_name};
  224. # Tag is not registered
  225. croak qq{Tag "$tag_name" is not registered } . _subname
  226. unless $tag;
  227. # Tag not sub reference
  228. croak qq{Tag "$tag_name" must be sub reference } . _subname
  229. unless ref $tag eq 'CODE';
  230. # Execute tag
  231. my $r = $tag->(@$tag_args);
  232. # Check tag return value
  233. croak qq{Tag "$tag_name" must return [STRING, ARRAY_REFERENCE] }
  234. . _subname
  235. unless ref $r eq 'ARRAY' && defined $r->[0] && ref $r->[1] eq 'ARRAY';
  236. # Part of SQL statement and colum names
  237. my ($part, $columns) = @$r;
  238. # Add columns
  239. push @$all_columns, @$columns;
  240. # Join part tag to SQL
  241. $sql .= $part;
  242. }
  243. }
  244. # Query
  245. my $query = DBIx::Custom::Query->new(
  246. sql => $sql,
  247. columns => $all_columns,
  248. tables => $tables,
  249. tag_count => $tag_count
  250. );
  251. return $query;
  252. }
  253.  
  254. # DEPRECATED!
  255. has tag_processors => sub { {} };
  256.  
  257. # DEPRECATED!
  258. sub register_tag_processor {
  259. my $self = shift;
  260. warn "register_tag_processor is DEPRECATED!";
  261. # Merge tag
  262. my $tag_processors = ref $_[0] eq 'HASH' ? $_[0] : {@_};
  263. $self->tag_processors({%{$self->tag_processors}, %{$tag_processors}});
  264. return $self;
  265. }
  266.  
  267. 1;
  268.  
  269. =head1 NAME
  270.  
  271. DBIx::Custom::QueryBuilder - Query builder
  272.  
  273. =head1 SYNOPSIS
  274. my $builder = DBIx::Custom::QueryBuilder->new;
  275. my $query = $builder->build_query(
  276. "select from table title = :title and author = :author"
  277. );
  278.  
  279. =head1 ATTRIBUTES
  280.  
  281. =head2 C<dbi>
  282.  
  283. my $dbi = $builder->dbi;
  284. $builder = $builder->dbi($dbi);
  285.  
  286. L<DBIx::Custom> object.
  287.  
  288. =head1 METHODS
  289.  
  290. L<DBIx::Custom::QueryBuilder> inherits all methods from L<Object::Simple>
  291. and implements the following new ones.
  292.  
  293. =head2 C<build_query>
  294. my $query = $builder->build_query($source);
  295.  
  296. Create a new L<DBIx::Custom::Query> object from SQL source.
  297.  
  298. =cut