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