use
vars
qw(@EXPORT_OK %EXPORT_TAGS $VERSION)
;
$VERSION
= 0.05;
@EXPORT_OK
=
qw(
sql_relationship
sql_column
sql_lob
sql_index
sql_cond
sql_and
sql_or
)
;
%EXPORT_TAGS
= (
all
=> \
@EXPORT_OK
);
has
'$.id'
;
has
'$.query_from'
;
has
'&.query_from_helper'
;
has
'%.subquery_columns'
=> (
item_accessor
=>
'subquery_column'
,
associated_class
=>
'SQL::Entity::Column'
,
index_by
=>
'id'
,
the_other_end
=>
'entity'
,
);
has
'$.unique_expression'
;
has
'$.unique_row_column'
;
has
'%.to_one_relationships'
=> (
associated_class
=>
'SQL::Entity::Relationship'
,
item_accessor
=>
'to_one_relationship'
,
index_by
=>
'name'
);
has
'%.to_many_relationships'
=> (
associated_class
=>
'SQL::Entity::Relationship'
,
item_accessor
=>
'to_many_relationship'
,
index_by
=>
'name'
,
on_change
=>
sub
{
my
(
$self
,
$attribute
,
$scope
,
$value
,
$key
) =
@_
;
if
(
$scope
eq
'mutator'
) {
foreach
my
$relation
(
values
%
$$value
) {
$relation
->associate_the_other_end(
$self
);
}
}
else
{
$$value
->associate_the_other_end(
$self
);
}
$self
;
}
);
has
'%.sql_template_parameters'
=> (
item_accessor
=>
'sql_template_parameter'
);
{
my
%loaded
;
has
'$.dml_generator'
=> (
default
=>
'SQL::DMLGenerator'
,
on_read
=>
sub
{
my
(
$self
,
$attribute
,
$scope
,
$value
) =
@_
;
my
$result
=
$attribute
->get_value(
$self
);
unless
(
$loaded
{
$result
}) {
my
$module
=
$result
;
$module
=~ s/::/\//g;
$module
.=
".pm"
;
eval
{
require
$module
;
$loaded
{
$result
} = 1;
}
}
$result
;
}
);
}
sub
initialise {
my
(
$self
) =
@_
;
$self
->SUPER::initialise();
unless
(
$self
->id) {
my
$schema
=
$self
->schema;
$self
->set_id((
$schema
?
$schema
.
"."
:
""
) .
$self
->name);
}
$self
->initialise_unique_row_column;
}
sub
initialise_unique_row_column {
my
(
$self
) =
@_
;
unless
(
$self
->unique_expression) {
my
@pk
=
$self
->primary_key;
confess
"unique_expression or primary_key is required"
unless
(
@pk
);
my
$alias
=
@pk
> 1 ?
$self
->alias :
""
;
$self
->unique_expression(
join
"||"
,
@pk
);
}
if
(
$self
->unique_expression) {
my
$unique_expression
=
$self
->unique_expression;
$self
->set_unique_row_column(
sql_column(
(
$unique_expression
=~ m/[^\w]/ ?
'expression'
:
'name'
) =>
$self
->unique_expression,
id
=> THE_ROWID() ,
table
=>
$self
,
updatable
=> 0,
insertable
=> 0,
)
);
}
}
sub
set_relationship_join_method {
my
(
$self
,
$column
,
$method
,
$join_methods
) =
@_
;
my
$table
=
$column
->table;
if
(
$table
&&
$table
ne
$self
) {
return
if
$join_methods
->{
$table
->id};
$join_methods
->{
$table
->id} =
$method
;
}
}
sub
query {
my
(
$self
,
@args
) =
@_
;
my
(
$sql
,
$bind_variables
) =
$self
->SUPER::query(
@args
);
$sql
=
$self
->parse_template_parameters(
$sql
);
(
$sql
,
$bind_variables
);
}
sub
lock
{
my
(
$self
,
@args
) =
@_
;
my
(
$sql
,
$bind_variables
) =
$self
->SUPER::query(
@args
);
$sql
.=
" FOR UPDATE"
;
(
$sql
,
$bind_variables
);
}
sub
insert {
my
(
$self
,
%args
) =
@_
;
my
@columns
=
$self
->insertable_columns;
my
%field_values
;
foreach
my
$column
(
@columns
) {
my
$name
=
$column
->name;
$field_values
{
$name
} =
$args
{
$name
};
}
my
$dml_generator
=
$self
->dml_generator;
$dml_generator
->insert(
$self
, \
%field_values
);
}
sub
update {
my
(
$self
,
$fields_values
,
$conditions
) =
@_
;
my
@columns
=
$self
->updatable_columns;
my
%field_values
;
foreach
my
$column
(
@columns
) {
my
$name
=
$column
->name;
next
unless
exists
(
$fields_values
->{
$name
});
$field_values
{
$name
} =
$fields_values
->{
$name
};
}
my
$dml_generator
=
$self
->dml_generator;
$dml_generator
->update(
$self
, \
%field_values
,
$conditions
);
}
sub
delete
{
my
(
$self
,
@args
) =
@_
;
my
$dml_generator
=
$self
->dml_generator;
$dml_generator
->
delete
(
$self
,
@args
);
}
sub
unique_condition_values {
my
(
$self
,
$fields_values
,
$validate
) =
@_
;
my
$column
=
$self
->unique_row_column;
my
%result
;
if
(
$fields_values
&&
$column
&& (
defined
$fields_values
->{
$column
->id} || (
$column
->name &&
$fields_values
->{
$column
->name}))) {
my
$column_name
=
$column
->name ||
$column
->expression;
my
$value
= (
$fields_values
->{
$column
->id} ||
$fields_values
->{
$column_name
});
$result
{
$column_name
} =
$value
if
$value
;
}
else
{
my
@pk
=
$self
->primary_key;
for
my
$column
(
@pk
) {
next
unless
exists
$fields_values
->{
$column
};
my
$value
=
$fields_values
->{
$column
};
$result
{
$column
} =
$value
if
defined
$value
;
}
}
unless
(
%result
) {
my
@columns
=
values
%{
$self
->columns};
for
my
$column
(
@columns
) {
if
(
$column
->unique) {
my
$column_name
=
$column
->name;
my
$value
=
$fields_values
->{
$column_name
};
if
(
defined
$value
) {
$result
{
$column_name
} =
$value
;
last
;
}
}
}
confess
"cant find unique value: on dataset: \n\t"
.
join
",\n\t"
,
map
{
$_
.
" => "
. (
$fields_values
->{
$_
} ||
''
)}
keys
%$fields_values
if
!(
%result
) &&
$validate
;
}
wantarray
? (
%result
) : \
%result
;
}
sub
selectable_columns {
my
(
$self
,
$requested_columns
) =
@_
;
my
$subquery_columns
=
$self
->subquery_columns;
my
@result
= (
$self
->unique_row_column, (
values
%$subquery_columns
),
$self
->SUPER::selectable_columns(
$requested_columns
));
if
(
@$requested_columns
) {
my
%column_hash
=
map
{
$_
->id,
$_
}
@result
;
return
map
{
$column_hash
{
$_
} ? (
$column_hash
{
$_
}) : ()}
@$requested_columns
;
}
@result
;
}
sub
from_sql_clause {
my
(
$self
,
$join_methods
) =
@_
;
my
$query_from
=
$self
->query_from;
my
$query_from_helper
=
$self
->query_from_helper;
$query_from
=
$query_from_helper
->(
$self
)
if
$query_from_helper
;
my
$alias
=
$self
->alias;
my
$name
=
$self
->name;
(
$query_from
?
"( $query_from )"
.
$self
->from_clause_alias
:
$self
->SUPER::from_clause_params(
$join_methods
))
}
sub
from_clause_params {
my
(
$self
,
$join_methods
) =
@_
;
$self
->from_sql_clause(
$join_methods
) .
$self
->join_clause(
$join_methods
);
}
sub
join_clause {
my
(
$self
,
$join_methods
) =
@_
;
my
$result
=
''
;
foreach
my
$k
(
keys
%$join_methods
) {
my
$relation
= (
$self
->to_one_relationship(
$k
) ||
$self
->to_many_relationship(
$k
)) or
return
''
;
my
$target_entity
=
$relation
->target_entity;
my
$join_method
=
$join_methods
->{
$k
};
next
if
$join_method
ne
'JOIN'
;
my
$condition
=
$relation
->condition;
my
%query_columns
=
$target_entity
->query_columns;
$result
.=
"\n${join_method} "
.
$target_entity
->from_clause_params(
$join_methods
)
.
" ON ("
.
$relation
->join_condition_as_string(
$self
) .
")"
;
}
$result
;
}
sub
relationship_query {
my
(
$self
,
$relation_name
,
@args
) =
@_
;
my
$relationship
=
$self
->relationship(
$relation_name
)
or confess
"cant find relationship ${relation_name}"
;
my
$entity
=
$relationship
->target_entity;
my
(
$sql
,
$bind_variables
) =
$entity
->query();
my
$condition
=
$self
->condition_converter(
@args
);
$sql
.=
"\nWHERE EXISTS (SELECT 1 FROM "
.
$self
->from_sql_clause
.
" WHERE "
.
$relationship
->join_condition_as_string(
$self
,
$bind_variables
,
$condition
) .
")"
.
$relationship
->order_by_clause;
(
$sql
,
$bind_variables
);
}
sub
normalise_field_names {
my
(
$self
,
@args
) =
@_
;
my
%columns
=
$self
->query_columns;
my
@result
;
for
(
my
$i
= 0;
$i
<
$#args
;
$i
+=2) {
my
$column
=
$args
[
$i
];
push
@result
, ((
$columns
{
$column
} ?
$columns
{
$column
}->name :
$column
),
$args
[
$i
+ 1]);
}
@result
}
sub
relationship {
my
(
$self
,
$relation_name
) =
@_
;
my
$result
=
$self
->to_many_relationship(
$relation_name
) ||
$self
->to_one_relationship(
$relation_name
) ||
''
;
confess
"cant find relationship $result"
unless
$result
;
$result
;
}
sub
query_columns {
my
(
$self
) =
@_
;
(THE_ROWID() =>
$self
->unique_row_column,
$self
->subquery_columns,
$self
->SUPER::query_columns);
}
sub
condition_converter {
my
(
$self
,
@args
) =
@_
;
(
@args
> 1)
? SQL::Entity::Condition->struct_to_condition(
@args
)
:
$args
[0];
}
sub
parse_template_parameters {
my
(
$self
,
$sql
) =
@_
;
my
$sql_template_parameters
=
$self
->sql_template_parameters or
return
$sql
;
for
my
$k
(
keys
%$sql_template_parameters
) {
my
$value
=
$sql_template_parameters
->{
$k
};
$sql
=~ s/\[\%\s+
$k
\s+\%\]/
$value
/g;
}
$sql
;
}
sub
clone {
my
$self
=
shift
;
dclone
$self
;
}
1;