1#!/usr/bin/perl
2
3use warnings;
4use strict;
5
6use Alzabo::Create;
7use Text::Autoformat qw(autoformat form);
8
9my $name;
10unless ( $name = $ARGV[0] )
11{
12    print "Usage: alzabo_to_ascii  schema\n";
13    exit;
14}
15
16my $schema = Alzabo::Create::Schema->load_from_file( name => $name );
17
18my @out;
19
20# 60 chars wide
21###############################################################################
22my $schema_title = <<'EOF';
23^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
24-------------------------------------------------------------------------------
25
26EOF
27
28###############################################################################
29my $table_title  = <<'EOF';
30  [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[
31  -----------------------------------------------------------------------------
32  \|  Name                    \|  Type                  \| Null? \| Default  \|    \|
33  -----------------------------------------------------------------------------
34EOF
35
36my $column = <<'EOF';
37  \| [[[[[[[[[[[[[[[[[[[[[[[[ \| [[[[[[[[[[[[[[[[[[[[[[ \| [[[[[ \| [[[[[[[[ \| [[ \|
38EOF
39
40my $column_comment = <<'EOF';
41  \| - [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ \|
42EOF
43
44my $fk_comment = <<'EOF';
45  \| - [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ \|
46EOF
47
48my $lj_table_line = <<'EOF';
49  \| [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ \|
50EOF
51
52render_schema($schema);
53
54print join '', @out;
55
56sub render_schema
57{
58    my $schema = shift;
59
60    push @out, form $schema_title,
61	'Schema: ' . $schema->name . ' (' . $schema->rules->rules_id . ')';
62
63    foreach my $t ($schema->tables)
64    {
65	render_table($t);
66    }
67}
68
69sub render_table
70{
71    my $t = shift;
72
73    # indent 2 spaces
74    push @out, form $table_title, $t->name;
75
76    foreach my $c ($t->columns)
77    {
78	render_column($c);
79    }
80
81    push @out, '  ' . '-' x 77;
82    push @out, "\n";
83
84    if ( $t->all_foreign_keys )
85    {
86	push @out, form $lj_table_line, 'Foreign keys';
87	push @out, '  ' . '-' x 77;
88	push @out, "\n";
89
90	foreach my $fk ($t->all_foreign_keys)
91	{
92	    render_foreign_key($fk);
93	    push @out, '  ' . '-' x 77;
94	    push @out, "\n";
95	}
96    }
97
98    if ( $t->indexes )
99    {
100	push @out, form $lj_table_line, 'Indexes';
101	push @out, '  ' . '-' x 77;
102	push @out, "\n";
103
104	foreach my $i ($t->indexes)
105	{
106	    render_index($i);
107	    push @out, '  ' . '-' x 77;
108	    push @out, "\n";
109	}
110    }
111
112    push @out, "\n";
113
114    my $comment = $t->comment;
115    if ( defined $comment && length $comment )
116    {
117	$comment =~ s/\r\n?/\n/g;
118	$comment =~ s/\n$//;
119
120	push @out, autoformat( $comment, { all => 1 } );
121	push @out, "\n\n";
122    }
123}
124
125sub render_column
126{
127    my $c = shift;
128
129    my $type = $c->type;
130    if ( $c->length )
131    {
132	$type .= '(';
133	$type .= $c->length;
134	$type .= ', ' . $c->precision if $c->precision;
135	$type .= ')';
136    }
137
138    if ($c->attributes)
139    {
140	$type .= '  ';
141	$type .= join ' ', sort $c->attributes;
142    }
143
144    push @out, form $column,
145	( $c->name,
146	  $type,
147	  ( $c->nullable ? 'Y' : '' ),
148	  ( defined $c->default ? $c->default : ''),
149	  ( $c->is_primary_key ? 'PK' : '' )
150	);
151
152    my $comment = $c->comment;
153    if ( defined $comment && length $comment )
154    {
155	push @out, form $column_comment, $comment;
156    }
157}
158
159sub render_foreign_key
160{
161    my $fk = shift;
162
163    foreach my $p ( $fk->column_pairs )
164    {
165	push @out, form $lj_table_line, $p->[0]->name . ' => ' . $p->[1]->table->name . '.' . $p->[1]->name;
166    }
167
168    my $to = $fk->table_to->name;
169
170    my ($amount, $verb);
171    my $plural = '';
172    if ( $fk->from_is_dependent )
173    {
174	$verb = 'must be';
175
176	if ( $fk->is_one_to_many )
177	{
178	    $amount = 'one or more';
179	    $plural = 's';
180	}
181	else
182	{
183	    $amount = 'one and only one';
184	}
185    }
186    else
187    {
188	$verb = 'can be';
189
190	if ( $fk->is_one_to_many )
191	{
192	    $amount = 'zero or more';
193	    $plural = 's';
194	}
195	else
196	{
197	    $amount = 'zero or one';
198	}
199    }
200
201    push @out, form $lj_table_line, "There $verb $amount corresponding row$plural in the foreign table";
202
203    my $comment = $fk->comment;
204    if ( length $comment )
205    {
206	push @out, form $fk_comment, $comment;
207    }
208}
209
210sub render_index
211{
212    my $i = shift;
213
214    my @i;
215    foreach my $c ( $i->columns )
216    {
217	my $spec = $c->name;
218	$spec .= '(' . $i->prefix($c) . ')' if $i->prefix($c);
219
220	push @i, $spec;
221    }
222
223    my $out = join ', ', @i;
224    $out .= ' -- unique' if $i->unique;
225    $out .= ' -- fulltext' if $i->fulltext;
226
227    push @out, form $lj_table_line, $out;
228}
229