#!/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;
}
syntax highlighted by Code2HTML, v. 0.9.1