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