maint/gen_dbictest_schema_diagram

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use DBICTest;
   7
   8 use Module::Runtime 'use_module';
   9 use SQL::Translator;
  10 use Path::Class 'file';
  11 use Getopt::Long;
  12 my $getopt = Getopt::Long::Parser->new(
  13   config => [qw/gnu_getopt bundling_override no_ignore_case/]
  14 );
  15 my $args = {};
  16 $getopt->getoptions($args, qw/
  17   diagram-out=s@
  18   schema-class=s@
  19 /);
  20
  21 die "You need to specify one diagram output filename via --diagram-out\n"
  22   if @{$args->{'diagram-out'}||[]} != 1;
  23
  24 die "You need to specify one DBIC schema class via --schema-class\n"
  25   if @{$args->{'schema-class'}||[]} != 1;
  26
  27 my $diagram_fh;
  28 if ($args->{'diagram-out'}[0] eq '-') {
  29   $diagram_fh = *STDOUT;
  30 }
  31 else {
  32   my $fn = file($args->{'diagram-out'}[0]);
  33   $fn->dir->mkpath;
  34   open $diagram_fh, '>', $fn
  35     or die "Unable to open $fn: $!\n";
  36 }
  37 binmode $diagram_fh;  # avoid win32 \n crapfest
  38
  39 my $schema_class = $args->{'schema-class'}[0];
  40 use_module( $schema_class );
  41 my $schema = $schema_class->connect( DBICTest->_database(quote_char => '"') );
  42
  43 my $trans = SQL::Translator->new(
  44   parser        => 'SQL::Translator::Parser::DBIx::Class',
  45   parser_args   => { dbic_schema => $schema },
  46   producer      => 'GraphViz',
  47   producer_args => {
  48     show_constraints => 1,
  49     show_datatypes   => 1,
  50     show_sizes       => 1,
  51     out_file         => $diagram_fh,
  52     output_type      => 'svg',
  53     layout           => 'neato',
  54   }
  55 );
  56
  57 $trans->translate or die $trans->error;