$VERSION
= 0.01;
has
'%.entities'
=> (
item_accessor
=>
'entity'
,
index_by
=>
'id'
);
has
'%._entities_subquery_columns'
;
has
'%._entities_to_many_relationships'
;
has
'%._entities_to_one_relationships'
;
has
'@.orm_files'
;
has
'@.entities_files'
;
has
'@.sequence_generators'
;
has
'@.table_generators'
;
has
'@._orm_mapping'
;
has
'$.entity_manager'
;
has
'$.cached_version'
;
has
'%.file_stats'
=> (
item_accessor
=>
'file_stat'
);
sub
load_persistence_context {
my
(
$self
,
$xml
,
$file
) =
@_
;
my
$entity_manager
=
$self
->entity_manager;
if
(!
$self
->cached_version) {
my
$entity_files
=
$self
->entities_files;
my
$orm_files
=
$self
->orm_files;
my
$entity_xml_hander
=
$xml
->entity_xml_handler;
my
$orm_xml_handler
=
$xml
->orm_xml_handler;
my
$prefix_dir
=
$xml
->persistence_dir;
for
my
$entity_ref
(
@$entity_files
) {
my
$file_name
=
$prefix_dir
.
$entity_ref
->{file};
$self
->add_file_stat(
$file_name
);
my
%overwriten_entity_attributes
= (
map
{
$_
ne
'file'
? (
$_
=>
$entity_ref
->{
$_
}) : ()}
keys
%$entity_ref
);
my
$entity
=
$entity_xml_hander
->parse_file(
$file_name
, \
%overwriten_entity_attributes
);
$self
->entity(
$entity
->id,
$entity
);
}
$self
->_initialise_subquery_columns();
$self
->_initialise_to_one_relationships();
$self
->_initialise_to_many_relationships();
$self
->_initialise_value_generators();
for
my
$orm_ref
(
@$orm_files
) {
my
$file_name
=
$prefix_dir
.
$orm_ref
->{file};
$self
->add_file_stat(
$file_name
);
$orm_xml_handler
->parse_file(
$file_name
);
}
if
(
$xml
->use_cache) {
$self
->_store(
$xml
,
$file
);
}
}
my
%entities
=
$self
->entities;
$entity_manager
->add_entities(
values
%entities
);
$self
->crate_orm_mappings();
$entity_manager
;
}
sub
_store {
my
(
$self
,
$xml
,
$file
) =
@_
;
my
$cache_file_name
=
$xml
->cache_file_name(
$file
);
$self
->set_cached_version(1);
store
$self
,
$cache_file_name
;
}
sub
load_from_cache {
my
(
$class
,
$xml
,
$file
) =
@_
;
my
$cache_file_name
=
$xml
->cache_file_name(
$file
);
my
$result
;
if
(-e
$cache_file_name
) {
$result
= retrieve(
$cache_file_name
);
}
$result
}
sub
can_use_cache {
my
(
$self
) =
@_
;
my
$result
= 1;
my
$file_stats
=
$self
->file_stats;
return
undef
unless
(
%$file_stats
);
for
my
$file
(
keys
%$file_stats
) {
my
$modification_time
= file_modification_time(
$file
);
return
if
$file_stats
->{
$file
} ne
$modification_time
;
}
$result
;
}
sub
_initialise_value_generators {
my
(
$self
) =
@_
;
$self
->_initialise_generators(
'Persistence::ValueGenerator::TableGenerator'
,
'table_generators'
);
$self
->_initialise_generators(
'Persistence::ValueGenerator::SequenceGenerator'
,
'sequence_generators'
);
}
sub
_initialise_generators {
my
(
$self
,
$class
,
$accessor
) =
@_
;
my
$entity_manager
=
$self
->entity_manager;
my
$generators
=
$self
->
$accessor
;
for
my
$generator
(
@$generators
) {
$class
->new(
%$generator
,
entity_manager_name
=>
$entity_manager
->name);
}
}
sub
_initialise_subquery_columns {
my
(
$self
) =
@_
;
my
$entities
=
$self
->entities;
my
$entities_subquery_columns
=
$self
->_entities_subquery_columns;
for
my
$entity_id
(
keys
%$entities_subquery_columns
) {
my
$entity
=
$entities
->{
$entity_id
};
my
@subquery_columns
;
my
$subquery_columns
=
$entities_subquery_columns
->{
$entity_id
};
for
my
$column_definition
(
@$subquery_columns
) {
push
@subquery_columns
,
$self
->entity_column(
$column_definition
->{entity},
$column_definition
->{name});
}
$entity
->add_subquery_columns(
@subquery_columns
)
if
@subquery_columns
;
}
}
sub
_initialise_to_one_relationships {
my
(
$self
) =
@_
;
$self
->_initialise_relationships(
'to_one_relationships'
);
}
sub
_initialise_to_many_relationships {
my
(
$self
) =
@_
;
$self
->_initialise_relationships(
'to_many_relationships'
);
}
sub
_initialise_relationships {
my
(
$self
,
$relationship_type
) =
@_
;
my
$entities
=
$self
->entities;
my
$relationship_accessor
=
"_entities_${relationship_type}"
;
my
$entities_relationships
=
$self
->
$relationship_accessor
;
my
$mutator
=
"add_${relationship_type}"
;
for
my
$entity_id
(
keys
%$entities_relationships
) {
my
$entity
=
$entities
->{
$entity_id
};
my
@relationships
;
my
$relationships
=
$entities_relationships
->{
$entity_id
};
for
my
$relationship
(
@$relationships
) {
push
@relationships
,
$self
->_relationship(
$relationship
);
}
if
(
@relationships
) {
$entity
->
$mutator
(
@relationships
)
}
}
}
sub
crate_orm_mappings {
my
(
$self
) =
@_
;
my
$orm_mapping
=
$self
->_orm_mapping;
for
(
my
$i
= 0;
$i
< $
$self
->create_orm_mapping(
$orm_mapping
->[
$i
],
$orm_mapping
->[
$i
+ 1]);
}
}
sub
create_orm_mapping {
my
(
$self
,
$args
,
$rules
) =
@_
;
my
$columns
=
$rules
->{columns};
my
$lobs
=
$rules
->{lobs};
my
$to_one_relationships
=
$rules
->{to_one_relationships};
my
$one_to_many_relationships
=
$rules
->{one_to_many_relationships};
my
$many_to_many_relationships
=
$rules
->{many_to_many_relationships};
$args
->{entity_name} =
$args
->{entity},
delete
$args
->{entity};
my
$orm
= Persistence::ORM->new(
%$args
);
my
$columns_map
= {};
for
my
$column
(
@$columns
) {
$columns_map
->{
$column
->{name}} = {
name
=>
$column
->{attribute}};
}
$orm
->set_columns(
$orm
->covert_to_attributes(
$columns_map
));
my
$lob_map
=
$orm
->covert_to_lob_attributes(
$lobs
);
$orm
->set_lobs(
$lob_map
);
for
my
$relation
(
@$to_one_relationships
) {
$self
->_add_to_one_relationship(
$relation
,
$orm
);
}
for
my
$relation
(
@$one_to_many_relationships
) {
$self
->_add_one_to_many_relationship(
$relation
,
$orm
);
}
for
my
$relation
(
@$many_to_many_relationships
) {
$self
->_add_many_to_many_relationship(
$relation
,
$orm
);
}
$orm
;
}
sub
_add_one_to_many_relationship {
my
(
$self
,
$relationship
,
$orm
) =
@_
;
Persistence::Relationship::OneToMany->add_relationship(
$self
->_add_relationship_parameters(
$relationship
,
$orm
));
}
sub
_add_many_to_many_relationship {
my
(
$self
,
$relationship
,
$orm
) =
@_
;
Persistence::Relationship::ManyToMany->add_relationship(
$self
->_add_relationship_parameters(
$relationship
,
$orm
));
}
sub
_add_to_one_relationship {
my
(
$self
,
$relationship
,
$orm
) =
@_
;
Persistence::Relationship::ToOne->add_relationship(
$self
->_add_relationship_parameters(
$relationship
,
$orm
));
}
sub
_add_relationship_parameters {
my
(
$self
,
$relationship
,
$orm
) =
@_
;
my
$attribute
=
$orm
->attribute(
$relationship
->{attribute});
my
@result
= (
$orm
->class,
$relationship
->{name},
attribute
=>
$attribute
);
if
(
my
$fetch_method
=
$relationship
->{fetch_method}) {
push
@result
,
'fetch_method'
=> Persistence::Relationship->
$fetch_method
();
}
if
(
my
$cascade
=
$relationship
->{cascade}) {
push
@result
,
'cascade'
=> Persistence::Relationship->
$cascade
();
}
if
(
my
$join_entity
=
$relationship
->{join_entity}) {
push
@result
,
'join_entity_name'
=>
$join_entity
;
}
@result
;
}
sub
_relationship {
my
(
$self
,
$relationship
) =
@_
;
my
$target_entity
=
ref
(
$relationship
->{target_entity}) ?
$relationship
->{target_entity}->id :
$relationship
->{target_entity};
my
$entity
=
$self
->entity(
$target_entity
)
or confess
"unknow entity "
.
$target_entity
;
$relationship
->{target_entity} =
$entity
;
my
$condition
=
$relationship
->{condition};
$self
->_parse_condition(
$condition
)
if
$condition
;
sql_relationship(
%$relationship
);
}
sub
_parse_condition {
my
(
$self
,
$condition
) =
@_
;
{
my
$operand1
=
$condition
->operand1;
my
(
$entity
,
$column
) =
$self
->has_column(
$operand1
);
$condition
->set_operand1(
$self
->entity_column(
$entity
,
$column
))
if
(
$column
)
}
{
my
$operand2
=
$condition
->operand2;
my
(
$entity
,
$column
) =
$self
->has_column(
$operand2
);
$condition
->set_operand2(
$self
->entity_column(
$entity
,
$column
))
if
(
$column
)
}
my
$conditions
=
$condition
->conditions;
for
my
$k
(
@$conditions
) {
$self
->_parse_condition(
$k
);
}
}
sub
has_column {
my
(
$self
,
$text
) =
@_
;
(
$text
=~ m /^sql_column:(\w+)\.(\w+)/);
}
sub
entity_column {
my
(
$self
,
$entity_id
,
$column_id
) =
@_
;
my
$entities
=
$self
->entities;
my
$entity
=
$entities
->{
$entity_id
}
or confess
"unknown entity: ${entity_id}"
;
my
$column
=
$entity
->column(
$column_id
)
or confess
"unknown column ${column_id} on entity ${entity_id}"
;
}
sub
add_file_stat {
my
(
$self
,
$file
) =
@_
;
my
$modification_time
= file_modification_time(
$file
);
$self
->file_stat(
$file
,
$modification_time
);
}
sub
file_modification_time {
my
$file
=
shift
;
my
$modification_time
= (
stat
$file
)[9];
}
1;