f0278a0 13 years ago
1 contributor
158 lines | 3.887kb
  1. package DBIx::Custom::Where;
  2.  
  3. use strict;
  4. use warnings;
  5.  
  6. use base 'Object::Simple';
  7.  
  8. use overload 'bool' => sub {1}, fallback => 1;
  9. use overload '""' => sub { shift->to_string }, fallback => 1;
  10.  
  11. use Carp 'croak';
  12.  
  13. # Carp trust relationship
  14. push @DBIx::Custom::CARP_NOT, __PACKAGE__;
  15.  
  16. __PACKAGE__->attr(
  17. [qw/param query_builder safety_character/],
  18. clause => sub { [] },
  19. reserved_word_quote => ''
  20. );
  21.  
  22. sub to_string {
  23. my $self = shift;
  24. # Clause
  25. my $clause = $self->clause;
  26. $clause = ['and', $clause] unless ref $clause eq 'ARRAY';
  27. $clause->[0] = 'and' unless @$clause;
  28.  
  29. # Parse
  30. my $where = [];
  31. my $count = {};
  32. $self->_parse($clause, $where, $count, 'and');
  33. # Stringify
  34. unshift @$where, 'where' if @$where;
  35. return join(' ', @$where);
  36. }
  37.  
  38. our %VALID_OPERATIONS = map { $_ => 1 } qw/and or/;
  39. sub _parse {
  40. my ($self, $clause, $where, $count, $op) = @_;
  41. # Array
  42. if (ref $clause eq 'ARRAY') {
  43. # Start
  44. push @$where, '(';
  45. # Operation
  46. my $op = $clause->[0] || '';
  47. croak qq{"$op" is invalid operation}
  48. unless $VALID_OPERATIONS{$op};
  49. # Parse internal clause
  50. for (my $i = 1; $i < @$clause; $i++) {
  51. my $pushed = $self->_parse($clause->[$i], $where, $count, $op);
  52. push @$where, $op if $pushed;
  53. }
  54. pop @$where if $where->[-1] eq $op;
  55. # Undo
  56. if ($where->[-1] eq '(') {
  57. pop @$where;
  58. pop @$where;
  59. }
  60. # End
  61. else { push @$where, ')' }
  62. }
  63. # String
  64. else {
  65. # Column
  66. my $columns = $self->query_builder->build_query($clause)->columns;
  67. croak qq{Each tag contains one column name: tag "$clause"}
  68. unless @$columns == 1;
  69. my $column = $columns->[0];
  70. if (my $q = $self->reserved_word_quote) {
  71. $column =~ s/$q//g;
  72. }
  73. my $safety = $self->safety_character;
  74. croak qq{"$column" is not safety column name}
  75. unless $column =~ /^[$safety\.]+$/;
  76. # Column count up
  77. my $count = ++$count->{$column};
  78. # Push
  79. my $param = $self->param;
  80. my $pushed;
  81. if (ref $param eq 'HASH') {
  82. if (exists $param->{$column}) {
  83. if (ref $param->{$column} eq 'ARRAY') {
  84. $pushed = 1
  85. if exists $param->{$column}->[$count - 1]
  86. && ref $param->{$column}->[$count - 1] ne 'DBIx::Custom::NotExists';
  87. }
  88. elsif ($count == 1) {
  89. $pushed = 1;
  90. }
  91. }
  92. push @$where, $clause if $pushed;
  93. }
  94. elsif (!defined $param) {
  95. push @$where, $clause;
  96. $pushed = 1;
  97. }
  98. else { croak "Parameter must be hash reference or undfined value" }
  99. return $pushed;
  100. }
  101. }
  102.  
  103. 1;
  104.  
  105. =head1 NAME
  106.  
  107. DBIx::Custom::Where - Where clause
  108.  
  109. =head1 SYNOPSYS
  110.  
  111. my $where = DBIx::Custom::Where->new;
  112.  
  113. =head1 ATTRIBUTES
  114.  
  115. =head2 C<clause>
  116.  
  117. $where->clause(
  118. ['and', '{= title}', ['or', '{< date}', '{> date}']]
  119. );
  120.  
  121. Where clause. Above one is expanded to the following SQL by to_string
  122. If all parameter names is exists.
  123.  
  124. "where ( {= title} and ( {< date} or {> date} ) )"
  125.  
  126. =head2 C<param>
  127.  
  128. my $param = $where->param;
  129. $where = $where->param({title => 'Perl',
  130. date => ['2010-11-11', '2011-03-05']},
  131. name => ['Ken', 'Taro']);
  132.  
  133. =head2 C<safety_character>
  134.  
  135. my $safety_character = $self->safety_character;
  136. $dbi = $self->safety_character($name);
  137.  
  138. =head1 METHODS
  139.  
  140. =head2 C<to_string>
  141.  
  142. $where->to_string;
  143.  
  144. Convert where clause to string correspoinding to param name.
  145.