Commit | Line | Data |
aca7d777 |
1 | package SQL::Translator::Producer::HTML; |
2 | |
3 | # ------------------------------------------------------------------- |
a11fbaea |
4 | # $Id: HTML.pm,v 1.6 2003-08-19 15:43:52 kycl4rk Exp $ |
aca7d777 |
5 | # ------------------------------------------------------------------- |
6 | # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org> |
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 CGI; |
a11fbaea |
25 | use Data::Dumper; |
aca7d777 |
26 | use vars qw[ $VERSION ]; |
a11fbaea |
27 | $VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/; |
aca7d777 |
28 | |
29 | use SQL::Translator::Schema::Constants; |
30 | use SQL::Translator::Utils qw(header_comment); |
31 | |
32 | # ------------------------------------------------------------------- |
33 | sub produce { |
34 | my $t = shift; |
35 | my $schema = $t->schema; |
36 | my $schema_name = $schema->name || 'Schema'; |
37 | my $args = $t->producer_args; |
38 | my $q = CGI->new; |
51fc3588 |
39 | my $title = $args->{'title'} || "Description of $schema_name"; |
aca7d777 |
40 | |
aca7d777 |
41 | my $html = $q->start_html( |
42 | { -title => $title, -bgcolor => 'lightgoldenrodyellow' } |
43 | ) . $q->h1( $title ). '<a name="top">', $q->hr; |
44 | |
ad02944a |
45 | if ( my @table_names = map { $_->name } $schema->get_tables ) { |
46 | $html .= $q->start_table( { -width => '100%' } ). |
47 | $q->Tr( { -bgcolor => 'khaki' }, $q->td( $q->h2('Tables') ) ); |
48 | |
49 | for my $table ( @table_names ) { |
50 | $html .= $q->Tr( $q->td( qq[<a href="#$table">$table</a>] ) ); |
51 | } |
52 | $html .= $q->end_table; |
53 | } |
54 | |
aca7d777 |
55 | for my $table ( $schema->get_tables ) { |
56 | my $table_name = $table->name or next; |
57 | my @fields = $table->get_fields or next; |
a11fbaea |
58 | $html .= $q->table( |
aca7d777 |
59 | { -width => '100%' }, |
60 | $q->Tr( |
61 | { -bgcolor => 'khaki' }, |
ad02944a |
62 | $q->td( $q->h3( $table_name ) ) . qq[<a name="$table_name">], |
aca7d777 |
63 | $q->td( { -align => 'right' }, qq[<a href="#top">Top</a>] ) |
64 | ) |
65 | ); |
66 | |
a11fbaea |
67 | if ( my @comments = $table->comments ) { |
68 | $html .= '<b>Comments:</b><br><em>'.join('<br>', @comments).'</em>'; |
69 | } |
70 | |
aca7d777 |
71 | # |
72 | # Fields |
73 | # |
74 | $html .= $q->start_table( { -border => 1 } ) . $q->Tr( |
75 | { -bgcolor => 'lightgrey' }, |
76 | $q->th( [ |
77 | 'Field Name', |
78 | 'Data Type', |
79 | 'Size', |
80 | 'Default', |
81 | 'Other', |
82 | 'Foreign Key' |
83 | ] ) |
84 | ); |
85 | |
86 | for my $field ( @fields ) { |
87 | my $name = $field->name; |
88 | $name = qq[<a name="$table_name-$name">$name</a>]; |
89 | my $data_type = $field->data_type; |
90 | my $size = $field->size; |
91 | my $default = $field->default_value; |
ad02944a |
92 | my $comment = $field->comments || ''; |
aca7d777 |
93 | |
94 | my $fk; |
95 | if ( $field->is_foreign_key ) { |
96 | my $c = $field->foreign_key_reference; |
97 | my $ref_table = $c->reference_table || ''; |
98 | my $ref_field = ($c->reference_fields)[0]; |
99 | $fk = |
100 | qq[<a href="#$ref_table-$ref_field">$ref_table.$ref_field</a>]; |
101 | } |
102 | |
103 | my @other; |
104 | push @other, 'PRIMARY KEY' if $field->is_primary_key; |
105 | push @other, 'UNIQUE' if $field->is_unique; |
106 | push @other, 'NOT NULL' unless $field->is_nullable; |
ad02944a |
107 | push @other, $comment if $comment; |
aca7d777 |
108 | $html .= $q->Tr( $q->td( |
109 | { -bgcolor => 'white' }, |
110 | [ $name, $data_type, $size, $default, join(', ', @other), $fk ] |
111 | ) ); |
112 | } |
113 | $html .= $q->end_table; |
114 | |
115 | # |
116 | # Indices |
117 | # |
118 | if ( my @indices = $table->get_indices ) { |
119 | $html .= $q->h3('Indices'); |
120 | $html .= $q->start_table( { -border => 1 } ) . $q->Tr( |
121 | { -bgcolor => 'lightgrey' }, |
122 | $q->th( [ 'Name', 'Fields' ] ) |
123 | ); |
124 | |
125 | for my $index ( @indices ) { |
126 | $html .= $q->Tr( |
127 | { -bgcolor => 'white' }, |
128 | $q->td( [ $index->name, join( ', ', $index->fields ) ] ) |
129 | ); |
130 | } |
131 | |
132 | $html .= $q->end_table; |
133 | } |
134 | |
135 | $html .= $q->hr; |
136 | } |
137 | |
138 | $html .= qq[Created by <a href="http://sqlfairy.sourceforge.net">]. |
139 | qq[SQL::Translator</a>]; |
140 | |
141 | return $html; |
142 | } |
143 | |
144 | 1; |
145 | |
146 | # ------------------------------------------------------------------- |
147 | # Always be ready to speak your mind, |
148 | # and a base man will avoid you. |
149 | # William Blake |
150 | # ------------------------------------------------------------------- |
151 | |
152 | =head1 NAME |
153 | |
154 | SQL::Translator::Producer::HTML - HTML producer for SQL::Translator |
155 | |
156 | =head1 SYNOPSIS |
157 | |
158 | use SQL::Translator::Producer::HTML; |
159 | |
160 | =head1 DESCRIPTION |
161 | |
162 | Creates an HTML document describing the tables. |
163 | |
164 | =head1 AUTHOR |
165 | |
166 | Ken Y. Clark E<lt>kclark@cpan.orgE<gt> |
167 | |
168 | =cut |