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