lib/SQL/Translator/Producer/HTML.pm

   1 package SQL::Translator::Producer::HTML;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: HTML.pm,v 1.3 2003-06-27 16:28:21 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 CGI;
  25 use vars qw[ $VERSION ];
  26 $VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\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 $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