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