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