view release on metacpan or  search on metacpan

lib/DBIO/Generate/Relationships.pm  view on Meta::CPAN

package DBIO::Generate::Relationships;
# ABSTRACT: Relationship inference for DBIO::Generate

use strict;
use warnings;
use base qw/Class::Accessor::Grouped/;
use mro 'c3';
use Carp::Clan qw/^DBIO/;
use Scalar::Util 'weaken';
use List::Util qw/all any first/;
use Try::Tiny;
use Lingua::EN::Inflect::Phrase ();
use Lingua::EN::Tagger ();
use String::ToIdentifier::EN ();
use String::ToIdentifier::EN::Unicode ();
use namespace::clean;

__PACKAGE__->mk_group_accessors(simple => qw/
  inflect_plural
  inflect_singular
  rel_name_map
  rel_collision_map
  allow_extra_m2m_cols
  quiet
  _relnames_seen
/);

sub new {
  my ($class, %args) = @_;
  my $self = bless {}, $class;
  $self->allow_extra_m2m_cols($args{allow_extra_m2m_cols} // 0);
  $self->quiet($args{quiet} // 0);
  $self->rel_name_map($args{rel_name_map});
  $self->rel_collision_map($args{rel_collision_map} // {});
  $self->inflect_plural($args{inflect_plural});
  $self->inflect_singular($args{inflect_singular});
  return $self;
}


sub generate_code {
  my ($self, $tables, $class_for, $pk_for) = @_;

  $self->_relnames_seen({});

  my @tables = @$tables;
  my %all_code;

  while (my ($local_moniker, $rels, $uniqs) = @{ shift @tables || [] }) {
    my $local_class = $class_for->{$local_moniker} or next;

    my %counters;
    for my $rel (@$rels) {
      next unless $rel->{remote_moniker};
      $counters{ $rel->{remote_moniker} }++;
    }

    for my $rel (@$rels) {
      my $remote_moniker = $rel->{remote_moniker} or next;
      my $remote_class   = $class_for->{$remote_moniker} or next;

      my $remote_cols = $rel->{remote_columns};
      $remote_cols    = $pk_for->{$remote_moniker} // []
        unless $remote_cols && @$remote_cols;

      my $local_cols = $rel->{local_columns};

      if (@$local_cols != @$remote_cols) {
        croak "Column count mismatch: $local_moniker (@$local_cols) "