view release on metacpan or  search on metacpan

lib/Alzabo/Display/SWF/Schema.pm  view on Meta::CPAN

package Alzabo::Display::SWF::Schema;

use strict;
use warnings;

use SWF qw(:ALL);
use Alzabo::Display::SWF::Util qw/rgb2ary button_shape get_coordinates/;
use Alzabo::Display::SWF::Table;
use Alzabo::Display::SWF::Column;
use Alzabo::Display::SWF::Key;
use GraphViz;
use Alzabo::Runtime;
our $VERSION = '0.01';

SWF::setVersion(5);
my $scale = 5;
SWF::setScale($scale);

sub new {
  my $pkg = shift;
  my %p = @_;
  my $self = {};
  bless $self, $pkg;
  $self->{mov} = new SWF::Movie;
  $self->{ars} = Alzabo::Runtime::Schema->load_from_file(name => $p{name});
  $self->{cfg} = $p{cfg};
  $self->{gvz} = GraphViz->new(  qw/
    layout     neato
    no_overlap 1
    /,
    node  => {qw/ shape   box  fontname Courier /},
    graph => {qw/ splines false /, label => $p{name} },
  );
  return $self;
}

sub create_graph {
  my $self = shift;
  my $g = $self->{gvz};
  my (%fk, %tm);
  my @t = $self->{ars}->tables;
  for my $t ( @t ) {
    my $n = $t->name;
    $tm{$n} = Alzabo::Display::SWF::Table->new(
      $t, $self->{mov}, $scale, $self->{cfg},
    );
    $g->add_node( $n,
      height => ( 2 + $tm{$t->name}->{height} )/72,
      width  => ( 2 + $tm{$t->name}->{width} )/72
    );

    foreach my $fk ($t->all_foreign_keys)  {
      my @from_id = qw( columns_from columns_to );
      my $id1 = join "\0", map { $_->name } map { $fk->$_() }
                           @from_id, qw( table_from table_to );
      $id1 .= "\0";
      $id1 .= join "\0", $fk->cardinality;

      my @to_id = qw( columns_to columns_from );
      my $id2 = join "\0", map { $_->name } map { $fk->$_() }
                           @to_id, qw( table_to table_from );
      $id2 .= "\0";
      $id2 .= join "\0", reverse $fk->cardinality;

      next if $fk{$id1} || $fk{$id2};

      my %p;
      my ($taillabel) = $fk->cardinality;
      $taillabel .= 'd' if $fk->from_is_dependent;

      my ($headlabel) = reverse $fk->cardinality;
      $headlabel .= 'd' if $fk->to_is_dependent;
      $p{taillabel} = $taillabel;
      $p{headlabel} = $headlabel;

      if ($fk->is_one_to_one) {
	$p{dir} = 'none';
	$p{arrowhead} = $fk->from_is_dependent ? 'dot' : 'odot';
	$p{arrowtail} = $fk->to_is_dependent ? 'dot' : 'odot';
      }
      elsif ($fk->is_many_to_one) {
        $p{dir} = 'forward';
	$p{arrowhead} = $fk->from_is_dependent ? 'dot' : 'odot';