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

use warnings;
use strict;

use Alzabo::Create;
use Text::Autoformat qw(autoformat form);

my $name;
unless ( $name = $ARGV[0] )
{
    print "Usage: alzabo_to_ascii  schema\n";
    exit;
}

my $schema = Alzabo::Create::Schema->load_from_file( name => $name );

my @out;

# 60 chars wide
###############################################################################
my $schema_title = <<'EOF';
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-------------------------------------------------------------------------------

EOF

###############################################################################
my $table_title  = <<'EOF';
  [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[
  -----------------------------------------------------------------------------
  \|  Name                    \|  Type                  \| Null? \| Default  \|    \|
  -----------------------------------------------------------------------------
EOF

my $column = <<'EOF';
  \| [[[[[[[[[[[[[[[[[[[[[[[[ \| [[[[[[[[[[[[[[[[[[[[[[ \| [[[[[ \| [[[[[[[[ \| [[ \|
EOF

my $column_comment = <<'EOF';
  \| - [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ \|
EOF

my $fk_comment = <<'EOF';
  \| - [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ \|
EOF

my $lj_table_line = <<'EOF';
  \| [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ \|
EOF

render_schema($schema);

print join '', @out;

sub render_schema
{
    my $schema = shift;

    push @out, form $schema_title,
	'Schema: ' . $schema->name . ' (' . $schema->rules->rules_id . ')';

    foreach my $t ($schema->tables)
    {
	render_table($t);
    }
}

sub render_table
{
    my $t = shift;

    # indent 2 spaces
    push @out, form $table_title, $t->name;

    foreach my $c ($t->columns)
    {
	render_column($c);
    }

    push @out, '  ' . '-' x 77;
    push @out, "\n";

    if ( $t->all_foreign_keys )
    {
	push @out, form $lj_table_line, 'Foreign keys';
	push @out, '  ' . '-' x 77;
	push @out, "\n";

	foreach my $fk ($t->all_foreign_keys)
	{
	    render_foreign_key($fk);
	    push @out, '  ' . '-' x 77;
	    push @out, "\n";
	}
    }

    if ( $t->indexes )
    {
	push @out, form $lj_table_line, 'Indexes';
	push @out, '  ' . '-' x 77;
	push @out, "\n";

	foreach my $i ($t->indexes)
	{
	    render_index($i);
	    push @out, '  ' . '-' x 77;
	    push @out, "\n";
	}
    }

    push @out, "\n";

    my $comment = $t->comment;
    if ( defined $comment && length $comment )
    {
	$comment =~ s/\r\n?/\n/g;
	$comment =~ s/\n$//;

	push @out, autoformat( $comment, { all => 1 } );
	push @out, "\n\n";
    }
}

sub render_column
{
    my $c = shift;

    my $type = $c->type;
    if ( $c->length )
    {
	$type .= '(';
	$type .= $c->length;
	$type .= ', ' . $c->precision if $c->precision;
	$type .= ')';
    }

    if ($c->attributes)
    {
	$type .= '  ';
	$type .= join ' ', sort $c->attributes;
    }

    push @out, form $column,
	( $c->name,
	  $type,
	  ( $c->nullable ? 'Y' : '' ),
	  ( defined $c->default ? $c->default : ''),
	  ( $c->is_primary_key ? 'PK' : '' )
	);

    my $comment = $c->comment;
    if ( defined $comment && length $comment )
    {
	push @out, form $column_comment, $comment;
    }
}

sub render_foreign_key
{
    my $fk = shift;

    foreach my $p ( $fk->column_pairs )
    {
	push @out, form $lj_table_line, $p->[0]->name . ' => ' . $p->[1]->table->name . '.' . $p->[1]->name;
    }

    my $to = $fk->table_to->name;

    my ($amount, $verb);
    my $plural = '';
    if ( $fk->from_is_dependent )
    {
	$verb = 'must be';

	if ( $fk->is_one_to_many )
	{
	    $amount = 'one or more';
	    $plural = 's';
	}
	else
	{
	    $amount = 'one and only one';
	}
    }
    else
    {
	$verb = 'can be';

	if ( $fk->is_one_to_many )
	{
	    $amount = 'zero or more';
	    $plural = 's';
	}
	else
	{
	    $amount = 'zero or one';
	}
    }

    push @out, form $lj_table_line, "There $verb $amount corresponding row$plural in the foreign table";

    my $comment = $fk->comment;
    if ( length $comment )
    {
	push @out, form $fk_comment, $comment;
    }
}

sub render_index
{
    my $i = shift;

    my @i;
    foreach my $c ( $i->columns )
    {
	my $spec = $c->name;
	$spec .= '(' . $i->prefix($c) . ')' if $i->prefix($c);

	push @i, $spec;
    }

    my $out = join ', ', @i;
    $out .= ' -- unique' if $i->unique;
    $out .= ' -- fulltext' if $i->fulltext;

    push @out, form $lj_table_line, $out;
}