Рекурсивный обход DBIx :: Классовые отношения - PullRequest
2 голосов
/ 04 марта 2011

Какой самый быстрый способ получить список таблиц с зависимостями внешнего ключа, как прямых, так и косвенных, в подкласс DBIx :: Class foo? У меня есть база данных MySQL на основе DBIx :: Class :: Schema. Можно ли использовать 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].

1 Ответ

1 голос
/ 07 марта 2011

Приготовил это с 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);
...