lib/SQL/Translator/Producer/HTML.pm

   1 package SQL::Translator::Producer::HTML;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: HTML.pm,v 1.9 2003-08-20 17:14:27 kycl4rk Exp $
   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 Data::Dumper;
  25 use vars qw[ $VERSION ];
  26 $VERSION = sprintf "%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/;
  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 $args        = $t->producer_args;
  35     my $schema      = $t->schema;
  36     my $schema_name = $schema->name || 'Schema';
  37     my $title       = $args->{'title'} || "Description of $schema_name";
  38     my $q           = defined $args->{'pretty'}
  39                     ? do { require CGI::Pretty;
  40                             import CGI::Pretty;
  41                                    CGI::Pretty->new }
  42                     : do { require CGI;
  43                             import CGI;
  44                                    CGI->new };
  45
  46     my $html  = $q->start_html(
  47         { -title => $title, -bgcolor => 'lightgoldenrodyellow' }
  48     ) .  $q->h1( $title ) .  '<a name="top">', $q->hr;
  49
  50     if ( my @table_names = map {$_->name?$_->name:()} $schema->get_tables ) {
  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
  60     for my $table ( $schema->get_tables ) {
  61         my $table_name = $table->name       or next;
  62         my @fields     = $table->get_fields or next;
  63         $html         .= $q->table(
  64             { -width => '100%' },
  65             $q->Tr(
  66                 { -bgcolor => 'khaki' },
  67                 $q->td( $q->h3( $table_name ) ) . qq[<a name="$table_name">],
  68                 $q->td( { -align => 'right' }, qq[<a href="#top">Top</a>] )
  69             )
  70         );
  71
  72         if ( my @comments = map { $_ ? $_ : () } $table->comments ) {
  73             $html .= '<b>Comments:</b><br><em>'.join('<br>', @comments).'</em>';
  74         }
  75
  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 ) {
  92             my $name      = $field->name      || '';
  93                $name      = qq[<a name="$table_name-$name">$name</a>];
  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        = '';
 100
 101             if ( $field->is_foreign_key ) {
 102                 my $c         = $field->foreign_key_reference;
 103                 my $ref_table = $c->reference_table       || '';
 104                 my $ref_field = ($c->reference_fields)[0] || '';
 105                 $fk           =
 106                 qq[<a href="#$ref_table-$ref_field">$ref_table.$ref_field</a>];
 107             }
 108
 109             my @other = ();
 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;
 113             push @other, $comment      if $comment;
 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 ) {
 132                 my $name   = $index->name || '';
 133                 my $fields = join( ', ', $index->fields ) || '';
 134
 135                 $html .= $q->Tr(
 136                     { -bgcolor => 'white' },
 137                     $q->td( [ $name, $fields ] )
 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