DBICのスキーマから適当にplantuml用の出力を得るスクリプト

dbic_schema_to_plantuml.pl

#!/usr/bin/env perl

use strict;
use warnings;
use utf8;

use Plack::Util;
use Data::Section::Simple qw(get_data_section);
use Text::MicroTemplate qw(render_mt);

my $schema = shift or die <<"___";
Usage: perl $0 MyApp::Schema
___

Plack::Util::load_class($schema);

my $table_to_info = {};
my $package_to_tables_info = {};

for my $source_name ($schema->sources) {
	my $result_source = $schema->source($source_name);

	my $table = $result_source->name;
	my $pk_map = { map { $_ => 1 } $result_source->primary_columns };
	my $columns = [ map {
		{ name => $_, pk => $pk_map->{$_} ? 1 : 0 }
	} $result_source->columns ];

	my $package = "master_data";
	if ($table =~ /_history$/) {
		$package = "log_data";
	} elsif ($table =~ /^event(_|$)/) {
		$package = "event_data";
	} elsif ($table =~ /^user(_|$)/) {
		$package = "user_data";
	} elsif ($table =~ /^player(_|$)/) {
		$package = "player_data";
	}
	$table_to_info->{$table} = {
		table   => $table,
		columns => $columns,
		package => $package,
	};
	$package_to_tables_info->{$package}->{$table} = {
		table   => $table,
		columns => $columns,
		package => $package,
	};
}

my $package_to_rels_info = {};

for my $source_name ($schema->sources) {
	my $result_source = $schema->source($source_name);
	my $table = $result_source->name;
	for my $rel_name ($result_source->relationships) {
		my $rel_result_source = $result_source->related_source($rel_name);
		my $rel_table = $rel_result_source->name;
		if (my $package = same_package($table, $rel_table)) {
			my $key = join("-", sort ($table, $rel_table));
			$package_to_rels_info->{$package}->{$key} = {
				parent => $table,
				child  => $rel_table,
			};
		}
	}
}

sub same_package {
	my ($parent, $child) = @_;
	my $a = $table_to_info->{$parent}->{package};
	my $b = $table_to_info->{$child}->{package};
	return ($a eq $b) ? $a : 0;
}

print render_mt(
	get_data_section("plantuml.tpl"),
	$package_to_tables_info,
	$package_to_rels_info,
);

__DATA__

@@ plantuml.tpl
? my $package_to_tables_info = $_[0];
? my $package_to_rels_info   = $_[1];

@startuml

? for my $package (keys %{$package_to_tables_info}) {
package <?= $package ?> {
?   for my $table_info (values %{$package_to_tables_info->{$package}}) {
    class <?= $table_info->{table} ?> {
?     for my $column (@{$table_info->{columns}}) {
?       if ($column->{pk}) {
        - <?= $column->{name} ?>
?       } else {
        <?= $column->{name} ?>
?       }
?     }
    }
?   }

?     for my $rel_info (values %{$package_to_rels_info->{$package}}) {
    <?= $rel_info->{parent} ?> --- <?= $rel_info->{child} ?>
?     }
}

? }

@enduml