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