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