has
'_where'
=> (
is
=>
'ro'
,
isa
=> ArrayRef,
default
=>
sub
{ [] },
traits
=> [
qw( Array )
],
handles
=> {
'_add_where_element'
=>
'push'
,
'where_clause_elements'
=>
'elements'
,
'_has_no_where_elements'
=>
'is_empty'
,
'_get_where_element'
=>
'get'
,
},
);
has
'_link'
=> (
is
=>
'bare'
,
isa
=> HashRef,
default
=>
sub
{ { } },
traits
=> [
qw( Hash )
],
handles
=> {
'_set_linked'
=>
'set'
,
'_has_link'
=>
'exists'
,
}
);
sub
where {
my
$self
=
shift
;
if
(
@_
== 1) {
my
$operator
=
$_
[0];
if
(
$operator
eq
'('
) {
my
$element
= Storm::SQL::Fragment::Where::SubgroupStart->new;
$self
->_add_and_if_needed;
$self
->_add_where_element(
$element
);
}
elsif
(
$operator
eq
')'
) {
my
$element
= Storm::SQL::Fragment::Where::SubgroupEnd->new;
$self
->_add_where_element(
$element
);
}
else
{
my
$element
= Storm::SQL::Fragment::Where::Boolean->new(
$operator
);
$self
->_add_where_element(
$element
);
}
}
else
{
my
(
$arg1
,
$operator
,
@args
) =
@_
;
(
$arg1
,
@args
) =
$self
->args_to_sql_objects(
$arg1
,
@args
);
my
$element
= Storm::SQL::Fragment::Where::Comparison->new(
$arg1
,
$operator
,
@args
);
$self
->_add_and_if_needed;
$self
->_add_where_element(
$element
);
}
return
$self
;
}
sub
and {
my
(
$self
,
@args
) =
@_
;
$self
->where(
@args
)
if
@args
;
}
sub
or {
my
(
$self
,
@args
) =
@_
;
$self
->where(
'or'
);
$self
->where(
@args
)
if
@args
;
}
sub
group_start {
my
(
$self
) =
@_
;
$self
->where(
'('
);
}
sub
group_end {
my
(
$self
) =
@_
;
$self
->where(
')'
);
}
sub
_link {
my
(
$self
,
$attr
,
$class
) =
@_
;
my
$right_col
=
$class
->meta->primary_key->column;
if
( !
$self
->_has_link(
$attr
->name ) ) {
my
$column1
= Storm::SQL::Column->new(
$self
->class->meta->storm_table->name .
'.'
.
$attr
->column->name );
my
$column2
= Storm::SQL::Column->new(
$class
->meta->storm_table->name .
'.'
.
$class
->meta->primary_key->column->name );
my
$element
= Storm::SQL::Fragment::Where::Comparison->new(
$column1
,
'='
,
$column2
);
$self
->_add_and_if_needed;
$self
->_add_where_element(
$element
);
$self
->_set_linked(
$attr
->name, 1 );
}
}
sub
_where_clause {
my
(
$self
,
$skip_where
) =
@_
;
return
if
$self
->_has_no_where_elements;
my
$sql
=
''
;
$sql
.=
'WHERE '
unless
$skip_where
;
$sql
.=
join
q[ ]
,
map
{
$_
->sql }
$self
->where_clause_elements;
return
$sql
;
}
sub
_add_and_if_needed {
my
(
$self
) =
@_
;
return
if
!
$self
->_get_where_element( -1 );
my
$last
=
$self
->_get_where_element( -1 );
return
if
$last
->isa(
'Storm::SQL::Fragment::Where::Boolean'
);
return
if
$last
->isa(
'Storm::SQL::Fragment::Where::SubgroupStart'
);
$self
->where(
'and'
);
}
no
Moose::Role;
1;