use 5.10.1;
use strict;
# ABSTRACT: Handle relation information
our $AUTHORITY = 'cpan:CSSON'; # AUTHORITY
our $VERSION = '0.0200';
use Moo;
use Types::Standard qw/Str Bool Enum/;
use PerlX::Maybe qw/provided/;
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 };
}
# do not reorder
$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;
__END__
=pod
=encoding UTF-8
=head1 NAME
DBIx::Class::Visualizer::Relation - Handle relation information
=head1 VERSION
Version 0.0200, released 2016-09-19.
=head1 SOURCE
=head1 HOMEPAGE
=head1 AUTHOR
Erik Carlsson <info@code301.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2016 by Erik Carlsson.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut