Minor bug fixes ("top" and table links didn't work), added borders to tables,
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / HTML.pm
1 package SQL::Translator::Producer::HTML;
2
3 # -------------------------------------------------------------------
4 # $Id: HTML.pm,v 1.12 2004-02-11 21:28:53 kycl4rk Exp $
5 # -------------------------------------------------------------------
6 # Copyright (C) 2002-4 SQLFairy Authors
7 #
8 # This program is free software; you can redistribute it and/or
9 # modify it under the terms of the GNU General Public License as
10 # published by the Free Software Foundation; version 2.
11 #
12 # This program is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15 # General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License
18 # along with this program; if not, write to the Free Software
19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
20 # 02111-1307  USA
21 # -------------------------------------------------------------------
22
23 use strict;
24 use Data::Dumper;
25 use vars qw($VERSION $NOWRAP $NOLINKTABLE $NAME);
26
27 $VERSION = sprintf "%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/;
28 $NAME = join ', ', __PACKAGE__, $VERSION;
29 $NOWRAP = 0 unless defined $NOWRAP;
30 $NOLINKTABLE = 0 unless defined $NOLINKTABLE;
31
32 # Emit XHTML by default
33 $CGI::XHTML = $CGI::XHTML = 42;
34
35 use SQL::Translator::Schema::Constants;
36
37 # -------------------------------------------------------------------
38 # Main entry point.  Returns a string containing HTML.
39 # -------------------------------------------------------------------
40 sub produce {
41     my $t           = shift;
42     my $args        = $t->producer_args;
43     my $schema      = $t->schema;
44     my $schema_name = $schema->name || 'Schema';
45     my $title       = $args->{'title'} || "Description of $schema_name";
46     my $wrap        = ! (defined $args->{'nowrap'}
47                                ? $args->{'nowrap'}
48                                : $NOWRAP);
49     my $linktable   = ! (defined $args->{'nolinktable'}
50                                ? $args->{'nolinktable'}
51                                : $NOLINKTABLE);
52     my %stylesheet  = defined $args->{'stylesheet'}
53                     ? ( -style => { src => $args->{'stylesheet'} } )
54                     : ( );
55     my @html;
56     my $q           = defined $args->{'pretty'}
57                     ? do { require CGI::Pretty;
58                             import CGI::Pretty;
59                                    CGI::Pretty->new }
60                     : do { require CGI;
61                             import CGI; 
62                                    CGI->new };
63     my ($table, @table_names);
64
65     if ($wrap) {
66         push @html,
67             $q->start_html({
68                 -title => $title,
69                 %stylesheet,
70                 -meta => { generator => $NAME },
71             });
72             $q->h1({ -class => 'SchemaDescription' }, $title),
73             $q->hr;
74     }
75
76     @table_names = grep { length $_->name } $schema->get_tables; 
77
78     if ($linktable) {
79         # Generate top menu, with links to full table information
80         my $count = scalar(@table_names);
81         $count = sprintf "%d table%s", $count, $count == 1 ? '' : 's';
82
83         # Leading table of links
84         push @html, 
85             $q->comment("Table listing ($count)"),
86             $q->a({ -name => 'top' }),
87             $q->start_table({ -width => '100%', -class => 'LinkTable'}),
88
89             # XXX This needs to be colspan="$#{$table->fields}" class="LinkTableHeader"
90             $q->Tr(
91                 $q->td({ -class => 'LinkTableCell' },
92                     $q->h2({ -class => 'LinkTableTitle' },
93                         'Tables'
94                     ),
95                 ),
96             );
97
98         for my $table (sort @table_names) {
99             my $table_name = $table->name;
100             push @html, 
101                 $q->comment("Start link to table '$table_name'"),
102                 $q->Tr({ -class => 'LinkTableRow' },
103                     $q->td({ -class => 'LinkTableCell' },
104                         qq[<a id="${table_name}-link" href="#$table_name">$table_name</a>]
105                     )
106                 ),
107                 $q->comment("End link to table '$table_name'");
108         }
109         push @html, $q->end_table;
110     }
111
112     for my $table ($schema->get_tables) {
113         my $table_name = $table->name       or next;
114         my @fields     = $table->get_fields or next;
115         push @html,
116             $q->comment("Starting table '$table_name'"),
117             $q->a({ -name => $table_name }),
118             $q->table({ -class => 'TableHeader', -width => '100%' },
119                 $q->Tr({ -class => 'TableHeaderRow' },
120                     $q->td({ -class => 'TableHeaderCell' }, $q->h3($table_name)),
121                         qq[<a name="$table_name">],
122                     $q->td({ -class => 'TableHeaderCell', -align => 'right' },
123                         qq[<a href="#top">Top</a>]
124                     )
125                 )
126             );
127
128         if ( my @comments = map { $_ ? $_ : () } $table->comments ) {
129             push @html,
130                 $q->b("Comments:"),
131                     $q->br,
132                     $q->em(map { $q->br, $_ } @comments);
133         }
134
135         #
136         # Fields
137         #
138         push @html,
139             $q->start_table({ -border => 1 }),
140                 $q->Tr(
141                     $q->th({ -class => 'FieldHeader' },
142                            [ 
143                             'Field Name', 
144                             'Data Type', 
145                             'Size', 
146                             'Default Value', 
147                             'Other', 
148                             'Foreign Key' 
149                            ]
150                     ) 
151                 );
152
153         for my $field ( @fields ) {
154             my $name      = $field->name      || '';
155                $name      = qq[<a name="$table_name-$name">$name</a>];
156             my $data_type = $field->data_type || '';
157             my $size      = defined $field->size ? $field->size : '';
158             my $default   = defined $field->default_value 
159                             ? $field->default_value : '';
160             my $comment   = $field->comments  || '';
161             my $fk        = '';
162
163             if ($field->is_foreign_key) {
164                 my $c         = $field->foreign_key_reference;
165                 my $ref_table = $c->reference_table       || '';
166                 my $ref_field = ($c->reference_fields)[0] || '';
167                 $fk           = 
168                 qq[<a href="#$ref_table-$ref_field">$ref_table.$ref_field</a>];
169             }
170
171             my @other = ();
172             push @other, 'PRIMARY KEY' if $field->is_primary_key;
173             push @other, 'UNIQUE'      if $field->is_unique;
174             push @other, 'NOT NULL'    unless $field->is_nullable;
175             push @other, $comment      if $comment;
176             push @html,
177                 $q->Tr(
178                     $q->td({ -class => "FieldCellName" }, $name),
179                     $q->td({ -class => "FieldCellType" }, $data_type),
180                     $q->td({ -class => "FieldCellSize" }, $size),
181                     $q->td({ -class => "FieldCellDefault" }, $default),
182                     $q->td({ -class => "FieldCellOther" }, join(', ', @other)),
183                     $q->td({ -class => "FieldCellFK" }, $fk),
184                 );
185         }
186         push @html, $q->end_table;
187
188         #
189         # Indices
190         #
191         if ( my @indices = $table->get_indices ) {
192             push @html, 
193                 $q->h3('Indices'),
194                 $q->start_table({ -border => 1 }),
195                     $q->Tr({ -class => 'IndexRow' },
196                         $q->th([ 'Name', 'Fields' ]) 
197                     );
198
199             for my $index ( @indices ) {
200                 my $name   = $index->name || '';
201                 my $fields = join( ', ', $index->fields ) || '';
202
203                 push @html,
204                     $q->Tr({ -class => 'IndexCell' },
205                         $q->td( [ $name, $fields ] )
206                     );
207             }
208
209             push @html, $q->end_table;
210         }
211
212         #
213         # Constraints
214         #
215         my @constraints = 
216             grep { $_->type ne PRIMARY_KEY } $table->get_constraints;
217         if ( @constraints ) {
218             push @html, 
219                 $q->h3('Constraints'),
220                 $q->start_table({ -border => 1 }),
221                     $q->Tr({ -class => 'IndexRow' },
222                         $q->th([ 'Type', 'Fields' ]) 
223                     );
224
225             for my $c ( @constraints ) {
226                 my $type   = $c->type || '';
227                 my $fields = join( ', ', $c->fields ) || '';
228
229                 push @html,
230                     $q->Tr({ -class => 'IndexCell' },
231                         $q->td( [ $type, $fields ] )
232                     );
233             }
234
235             push @html, $q->end_table;
236         }
237
238         push @html, $q->hr;
239     }
240
241     my $sqlt_version = $t->version;
242     if ($wrap) {
243         push @html,
244             qq[Created by <a href="http://sqlfairy.sourceforge.net">],
245             qq[SQL::Translator $sqlt_version</a>],
246             $q->end_html;
247     }
248
249
250     return join "\n", @html;
251 }
252
253 1;
254
255 # -------------------------------------------------------------------
256 # Always be ready to speak your mind,
257 # and a base man will avoid you.
258 # William Blake
259 # -------------------------------------------------------------------
260
261 =head1 NAME
262
263 SQL::Translator::Producer::HTML - HTML producer for SQL::Translator
264
265 =head1 SYNOPSIS
266
267   use SQL::Translator::Producer::HTML;
268
269 =head1 DESCRIPTION
270
271 Creates an HTML document describing the tables.
272
273 The HTML produced is composed of a number of tables:
274
275 =over 4
276
277 =item Links
278
279 A link table sits at the top of the output, and contains anchored
280 links to elements in the rest of the document.
281
282 If the I<nolinktable> producer arg is present, then this table is not
283 produced.
284
285 =item Tables
286
287 Each table in the schema has its own HTML table.  The top row is a row
288 of E<lt>thE<gt> elements, with a class of B<FieldHeader>; these
289 elements are I<Field Name>, I<Data Type>, I<Size>, I<Default Value>,
290 I<Other> and I<Foreign Key>.  Each successive row describes one field
291 in the table, and has a class of B<FieldCell$item>, where $item id
292 corresponds to the label of the column.  For example:
293
294     <tr>
295         <td class="FieldCellName"><a name="random-id">id</a></td>
296         <td class="FieldCellType">int</td>
297         <td class="FieldCellSize">11</td>
298         <td class="FieldCellDefault"></td>
299         <td class="FieldCellOther">PRIMARY KEY, NOT NULL</td>
300         <td class="FieldCellFK"></td>
301     </tr>
302
303     <tr>
304         <td class="FieldCellName"><a name="random-foo">foo</a></td>
305         <td class="FieldCellType">varchar</td>
306         <td class="FieldCellSize">255</td>
307         <td class="FieldCellDefault"></td>
308         <td class="FieldCellOther">NOT NULL</td>
309         <td class="FieldCellFK"></td>
310     </tr>
311
312     <tr>
313         <td class="FieldCellName"><a name="random-updated">updated</a></td>
314         <td class="FieldCellType">timestamp</td>
315         <td class="FieldCellSize">0</td>
316         <td class="FieldCellDefault"></td>
317         <td class="FieldCellOther"></td>
318         <td class="FieldCellFK"></td>
319     </tr>
320
321 =back
322
323 Unless the I<nowrap> producer arg is present, the HTML will be
324 enclosed in a basic HTML header and footer.
325
326 If the I<pretty> producer arg is present, the generated HTML will be
327 nicely spaced and human-readable.  Otherwise, it will have very little
328 insignificant whitespace and be generally smaller.
329
330
331 =head1 AUTHORS
332
333 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
334 Darren Chamberlain E<lt>darren@cpan.orgE<gt>.
335
336 =cut