递归遍历 DBIx::Class 关系

Question

获取具有外键依赖关系（直接和间接）到 DBIx::Class 子类 foo 的表的列表的最快方法是什么？我有一个基于 DBIx::Class::Schema 的 MySQL 数据库。可以直接使用 DBIx::Class 吗？或者 SQL::Translator 可以通过生成有向图来提供帮助吗？

给定以下类：

package MySchema::Foo;

...

package MySchema::Bar;

__PACKAGE__->belongs_to('foo', 'MySchema::Foo');

package MySchema::Baz;

__PACKAGE__->belongs_to('bar', 'MySchema::Bar');

对于输入 Foo，输出应为 [ Bar, Baz ]。

Answer 1

使用 DBIx::Class 的 ::Schema 和 ::ResultSource 来完成此操作。首先构建引用类的哈希（ref），然后遍历它：

#!/usr/bin/perl

use strict;
use warnings;
use MySchema;
use Set::Scalar;

# add_sfk: adds a foreign key reference from $src to $dst
sub add_sfk {
    my ( $sfks, $src, $dst ) = @_;

    $sfks->{$src} ||= Set::Scalar->new;
    $sfks->{$src}->insert($dst);
}

my $conn = MySchema->connect(...);

my $scname = ref $conn;
my $sfks = {}; # the foreign key hash

# now we build the hash from sources relationships
foreach my $sname ($conn->sources) {
    my $s = $conn->source($sname);
    my $cname = $conn->class($sname);
    foreach my $rname ($s->relationships) {
        my $rel = $s->relationship_info($rname);
        my @conds = keys %{ $rel->{cond} };
        next if scalar @conds > 1; # reckon this should never happen
        (my $stgt = $rel->{source}) =~ s/^${scname}:://;
        foreach my $ckey (@conds) {
            add_sfk($sfks, $stgt, $sname) if ('foreign.id' eq $ckey); # belongs_to
            add_sfk($sfks, $sname, $stgt) if ('self.id' eq $rel->{cond}->{$ckey}); # has_(one|many)
        }
    }
}

my $sname = shift or die("No class given as input");

# time to traverse our hash to include indirect relationships
my $deps = $sfks->{$sname};
my $lastdeps = $deps;
my $newdeps;
do {
    $newdeps = Set::Scalar->new;
    foreach my $sn ($lastdeps->elements) {
        my $sdeps = $sfks->{$sn} or next;
        if ($sdeps -= $lastdeps) {
            $newdeps += $sdeps;
        }
    }
    $deps += $lastdeps;
    $lastdeps = $newdeps;
} while ($newdeps);

print "Dependencies of $sname:\n" . join("\n", map { $conn->source($_)->from } @$deps);