The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl

# -------------------------------------------------------------------
# Copyright (C) 2002-2011 SQLFairy Authors
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; version 2.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301 USA.
# -------------------------------------------------------------------

=head1 NAME

sqlt-diagram - Automatically create a diagram from a database schema

=head1 SYNOPSIS

  ./sqlt-diagram -d|-f|--from|--db=db_parser [options] schema.sql

  Options:

    -o|--output        Output file name (default STDOUT)
    -i|--image         Output image type ("png" or "jpeg," default "png")
    -t|--title         Title to give schema
    -c|--cols          Number of columns
    -n|--no-lines      Don't draw lines
    --font-size        Font size ("small," "medium," "large," or "huge,"
                       default "medium")
    --gutter           Gutter size between tables
    --color            Add colors
    --show-fk-only     Only show fields that act as primary
                       or foreign keys

    --natural-join     Perform natural joins
    --natural-join-pk  Perform natural joins from primary keys only
    -s|--skip          Fields to skip in natural joins
    --skip-tables      Comma-separated list of table names to exclude
    --skip-tables-like Comma-separated list of regexen to exclude tables
    --debug            Print debugging information

=head1 DESCRIPTION

This script will create a picture of your schema.  Only the database
driver argument (for SQL::Translator) is required.  If no output file
name is given, then image will be printed to STDOUT, so you should
redirect the output into a file.

The default action is to assume the presence of foreign key
relationships defined via "REFERENCES" or "FOREIGN KEY" constraints on
the tables.  If you are parsing the schema of a file that does not
have these, you will find the natural join options helpful.  With
natural joins, like-named fields will be considered foreign keys.
This can prove too permissive, however, as you probably don't want a
field called "name" to be considered a foreign key, so you could
include it in the "skip" option, and all fields called "name" will be
excluded from natural joins.  A more efficient method, however, might
be to simply deduce the foreign keys from primary keys to other fields
named the same in other tables.  Use the "natural-join-pk" option
to achieve this.

=cut

use strict;
use warnings;
use Data::Dumper;
use Getopt::Long;
use Pod::Usage;
use SQL::Translator;

use vars '$VERSION';
$VERSION = '1.59';

#
# Get arguments.
#
my (
    $out_file, $output_type, $db_driver, $title, $num_columns,
    $no_lines, $font_size, $add_color, $debug, $show_fk_only,
    $gutter, $natural_join, $join_pk_only, $skip_fields,
    $skip_tables, $skip_tables_like, $help
);

GetOptions(
    'd|db|f|from=s'      => \$db_driver,
    'o|output:s'         => \$out_file,
    'i|image:s'          => \$output_type,
    't|title:s'          => \$title,
    'c|columns:i'        => \$num_columns,
    'n|no-lines'         => \$no_lines,
    'font-size:s'        => \$font_size,
    'gutter:i'           => \$gutter,
    'color'              => \$add_color,
    'show-fk-only'       => \$show_fk_only,
    'natural-join'       => \$natural_join,
    'natural-join-pk'    => \$join_pk_only,
    's|skip:s'           => \$skip_fields,
    'skip-tables:s'      => \$skip_tables,
    'skip-tables-like:s' => \$skip_tables_like,
    'debug'              => \$debug,
    'h|help'             => \$help,
) or die pod2usage;
my @files = @ARGV; # the create script(s) for the original db

pod2usage(1) if $help;
pod2usage( -message => "No db driver specified" ) unless $db_driver;
pod2usage( -message => 'No input file'          ) unless @files;

my $translator       =  SQL::Translator->new(
    from             => $db_driver,
    to               => 'Diagram',
    debug            => $debug || 0,
    producer_args    => {
        out_file         => $out_file,
        output_type      => $output_type,
        gutter           => $gutter || 0,
        title            => $title,
        num_columns      => $num_columns,
        no_lines         => $no_lines,
        font_size        => $font_size,
        add_color        => $add_color,
        show_fk_only     => $show_fk_only,
        natural_join     => $natural_join,
        join_pk_only     => $join_pk_only,
        skip_fields      => $skip_fields,
        skip_tables      => $skip_tables,
        skip_tables_like => $skip_tables_like,
    },
) or die SQL::Translator->error;

binmode STDOUT unless $out_file;

for my $file (@files) {
    my $output = $translator->translate( $file ) or die
                 "Error: " . $translator->error;
    if ( $out_file ) {
        print "Image written to '$out_file'.  Done.\n";
    }
    else {
        print $output;
    }
}

# -------------------------------------------------------------------

=pod

=head1 AUTHOR

Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.

=cut