generate svg of DBICTest::Schema in author mode

[dbsrgits/DBIx-Class.git] / maint / gen_dbictest_schema_diagram

#!/usr/bin/env perl

use strict;
use warnings;

use DBICTest;

use Module::Runtime 'use_module';
use SQL::Translator;
use Path::Class 'file';
use Getopt::Long;
my $getopt = Getopt::Long::Parser->new(
  config => [qw/gnu_getopt bundling_override no_ignore_case/]
);
my $args = {};
$getopt->getoptions($args, qw/
  diagram-out=s@
  schema-class=s@
/);

die "You need to specify one diagram output filename via --diagram-out\n"
  if @{$args->{'diagram-out'}||[]} != 1;

die "You need to specify one DBIC schema class via --schema-class\n"
  if @{$args->{'schema-class'}||[]} != 1;

my $diagram_fh;
if ($args->{'diagram-out'}[0] eq '-') {
  $diagram_fh = *STDOUT;
}
else {
  my $fn = file($args->{'diagram-out'}[0]);
  $fn->dir->mkpath;
  open $diagram_fh, '>', $fn
    or die "Unable to open $fn: $!\n";
}
binmode $diagram_fh;  # avoid win32 \n crapfest

my $schema_class = $args->{'schema-class'}[0];
use_module( $schema_class );
my $schema = $schema_class->connect( DBICTest->_database(quote_char => '"') );

my $trans = SQL::Translator->new(
  parser        => 'SQL::Translator::Parser::DBIx::Class',
  parser_args   => { dbic_schema => $schema },
  producer      => 'GraphViz',
  producer_args => {
    show_constraints => 1,
    show_datatypes   => 1,
    show_sizes       => 1,
    out_file         => $diagram_fh,
    output_type      => 'svg',
    layout           => 'neato',
  }
);

$trans->translate or die $trans->error;