use
5.10.1;
our
$AUTHORITY
=
'cpan:CSSON'
;
our
$VERSION
=
'0.0200'
;
Readonly::Scalar
my
$HAS_MANY
=>
'has_many'
;
Readonly::Scalar
my
$BELONGS_TO
=>
'belongs_to'
;
Readonly::Scalar
my
$HAS_ONE
=>
'has_one'
;
Readonly::Scalar
my
$MIGHT_HAVE
=>
'might_have'
;
has
added_to_graph
=> (
is
=>
'rw'
,
isa
=> Bool,
default
=> 0,
);
has
origin_table
=> (
is
=>
'ro'
,
isa
=> Str,
required
=> 1,
);
has
origin_column
=> (
is
=>
'ro'
,
isa
=> Str,
required
=> 1,
);
has
destination_table
=> (
is
=>
'ro'
,
isa
=> Str,
required
=> 1,
);
has
destination_column
=> (
is
=>
'ro'
,
isa
=> Str,
required
=> 1,
);
has
cascade_delete
=> (
is
=>
'ro'
,
isa
=> Bool,
predicate
=> 1,
);
has
cascade_update
=> (
is
=>
'ro'
,
isa
=> Bool,
predicate
=> 1,
);
has
relation_type
=> (
is
=>
'ro'
,
isa
=> Enum[
qw/has_many has_one belongs_to might_have/
],
required
=> 1,
);
around
BUILDARGS
=>
sub
{
my
$orig
=
shift
;
my
$class
=
shift
;
my
%args
=
@_
;
my
$relation
=
delete
$args
{
'relation'
};
my
$attr
=
$relation
->{
'attrs'
};
(
$args
{
'destination_table'
} =
$relation
->{
'source'
}) =~ s{^.*?::Result::}{};
(
$args
{
'origin_column'
} = (
values
%{
$relation
->{
'cond'
} })[0]) =~ s{^self\.}{};
(
$args
{
'destination_column'
} = (
keys
%{
$relation
->{
'cond'
} })[0]) =~ s{^foreign\.}{};
for
my
$cascade
(
qw/cascade_delete cascade_update/
) {
$args
{
$cascade
} =
$attr
->{
$cascade
}
if
exists
$attr
->{
$cascade
};
}
$args
{
'relation_type'
} =
$attr
->{
'accessor'
} eq
'multi'
?
$HAS_MANY
:
$attr
->{
'is_depends_on'
} ?
$BELONGS_TO
:
exists
$attr
->{
'join_type'
} ?
$MIGHT_HAVE
:
$HAS_ONE
;
$class
->
$orig
(
%args
);
};
sub
is_belongs_to {
shift
->relation_type eq
$BELONGS_TO
}
sub
arrow_type {
my
$self
=
shift
;
return
join
''
,
$self
->relation_type eq
$HAS_MANY
?
qw/crow none odot/
:
$self
->relation_type eq
$BELONGS_TO
?
qw/none tee/
:
$self
->relation_type eq
$MIGHT_HAVE
?
qw/none tee none odot/
:
$self
->relation_type eq
$HAS_ONE
?
qw/vee/
:
qw/dot dot dot/
;
}
sub
TO_JSON {
my
$self
=
shift
;
return
+{
origin_table
=>
$self
->origin_table,
origin_column
=>
$self
->origin_column,
destination_table
=>
$self
->destination_table,
destination_column
=>
$self
->destination_column,
relation_type
=>
$self
->relation_type,
provided
$self
->has_cascade_delete,
cascade_delete
=>
$self
->cascade_delete,
provided
$self
->has_cascade_update,
cascade_update
=>
$self
->cascade_update,
};
}
1;