Commit | Line | Data |
2a267f86 |
1 | package SQL::Translator::Producer::POD; |
2 | |
3 | # ------------------------------------------------------------------- |
20770e44 |
4 | # $Id: POD.pm,v 1.4 2003-10-15 19:04:19 kycl4rk Exp $ |
2a267f86 |
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 | |
20770e44 |
23 | =head1 NAME |
24 | |
25 | SQL::Translator::Producer::POD - POD producer for SQL::Translator |
26 | |
27 | =head1 SYNOPSIS |
28 | |
29 | use SQL::Translator; |
30 | |
31 | my $t = SQL::Translator->new( parser => '...', producer => 'POD', '...' ); |
32 | print $t->translate; |
33 | |
34 | =head1 DESCRIPTION |
35 | |
36 | Creates a POD description of each table, field, index, and constraint. |
37 | A good starting point for text documentation of a schema. You can |
38 | easily convert the output to HTML or text using "perldoc" or other |
39 | interesting formats using Pod::POM or Template::Toolkit's POD plugin. |
40 | |
41 | =cut |
42 | |
2a267f86 |
43 | use strict; |
44 | use vars qw[ $VERSION ]; |
20770e44 |
45 | $VERSION = sprintf "%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/; |
2a267f86 |
46 | |
47 | use SQL::Translator::Schema::Constants; |
48 | use SQL::Translator::Utils qw(header_comment); |
49 | |
50 | # ------------------------------------------------------------------- |
51 | sub produce { |
52 | my $t = shift; |
53 | my $schema = $t->schema; |
54 | my $schema_name = $schema->name || 'Schema'; |
55 | my $args = $t->producer_args; |
cb002bb5 |
56 | my $title = $args->{'title'} || $schema_name; |
2a267f86 |
57 | |
cb002bb5 |
58 | my $pod = "=pod\n\n=head1 DESCRIPTION\n\n$title\n\n=head1 TABLES\n\n"; |
2a267f86 |
59 | |
60 | for my $table ( $schema->get_tables ) { |
61 | my $table_name = $table->name or next; |
62 | my @fields = $table->get_fields or next; |
63 | $pod .= "=head2 $table_name\n\n=head3 FIELDS\n\n"; |
64 | |
65 | # |
66 | # Fields |
67 | # |
b9124e4b |
68 | for my $field ( @fields ) { |
2a267f86 |
69 | $pod .= "=head4 " . $field->name . "\n\n=over 4\n\n"; |
70 | |
71 | my $data_type = $field->data_type; |
72 | my $size = $field->size; |
73 | $data_type .= "($size)" if $size; |
74 | |
75 | $pod .= "=item * $data_type\n\n"; |
76 | $pod .= "=item * PRIMARY KEY\n\n" if $field->is_primary_key; |
77 | |
78 | my $default = $field->default_value; |
79 | $pod .= "=item * Default '$default' \n\n" if defined $default; |
80 | |
81 | $pod .= sprintf( "=item * Nullable '%s' \n\n", |
82 | $field->is_nullable ? 'Yes' : 'No' ); |
83 | |
84 | $pod .= "=back\n\n"; |
85 | } |
86 | |
87 | # |
88 | # Indices |
89 | # |
90 | if ( my @indices = $table->get_indices ) { |
91 | $pod .= "=head3 INDICES\n\n"; |
92 | for my $index ( @indices ) { |
93 | $pod .= "=head4 " . $index->type . "\n\n=over 4\n\n"; |
94 | $pod .= "=item * Fields = " . |
95 | join(', ', $index->fields ) . "\n\n"; |
96 | $pod .= "=back\n\n"; |
97 | } |
98 | } |
99 | |
100 | # |
101 | # Constraints |
102 | # |
103 | if ( my @constraints = $table->get_constraints ) { |
104 | $pod .= "=head3 CONSTRAINTS\n\n"; |
105 | for my $c ( @constraints ) { |
106 | $pod .= "=head4 " . $c->type . "\n\n=over 4\n\n"; |
107 | $pod .= "=item * Fields = " . |
108 | join(', ', $c->fields ) . "\n\n"; |
109 | |
110 | if ( $c->type eq FOREIGN_KEY ) { |
b9124e4b |
111 | $pod .= "=item * Reference Table = L</" . |
112 | $c->reference_table . ">\n\n"; |
2a267f86 |
113 | $pod .= "=item * Reference Fields = " . |
b9124e4b |
114 | join(', ', map {"L</$_>"} $c->reference_fields ) . |
115 | "\n\n"; |
2a267f86 |
116 | } |
117 | |
118 | if ( my $update = $c->on_update ) { |
119 | $pod .= "=item * On update = $update"; |
120 | } |
121 | |
122 | if ( my $delete = $c->on_delete ) { |
123 | $pod .= "=item * On delete = $delete"; |
124 | } |
125 | |
126 | $pod .= "=back\n\n"; |
127 | } |
128 | } |
129 | } |
130 | |
b9124e4b |
131 | my $header = ( map { $_ || () } split( /\n/, header_comment('', '') ) )[0]; |
132 | $header =~ s/^Created by //; |
133 | $pod .= "=head1 PRODUCED BY\n\n$header\n\n=cut"; |
134 | |
2a267f86 |
135 | return $pod; |
136 | } |
137 | |
138 | 1; |
139 | |
140 | # ------------------------------------------------------------------- |
141 | # Expect poison from the standing water. |
142 | # William Blake |
143 | # ------------------------------------------------------------------- |
144 | |
20770e44 |
145 | =pod |
2a267f86 |
146 | |
147 | =head1 AUTHOR |
148 | |
20770e44 |
149 | Ken Y. Clark E<lt>kclark@cpan.orgE<gt>. |
2a267f86 |
150 | |
151 | =head1 SEE ALSO |
152 | |
20770e44 |
153 | perldoc, perlpod, Pod::POM, Template::Manual::Plugins. |
2a267f86 |
154 | |
155 | =cut |