[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / HTML.pm

package SQL::Translator::Producer::HTML;

# -------------------------------------------------------------------
# $Id$
# -------------------------------------------------------------------
# Copyright (C) 2002-4 SQLFairy Authors
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; version 2.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
# 02111-1307  USA
# -------------------------------------------------------------------

use strict;
use Data::Dumper;
use vars qw($VERSION $NOWRAP $NOLINKTABLE $NAME);

$VERSION = sprintf "%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/;
$NAME = join ', ', __PACKAGE__, $VERSION;
$NOWRAP = 0 unless defined $NOWRAP;
$NOLINKTABLE = 0 unless defined $NOLINKTABLE;

# Emit XHTML by default
$CGI::XHTML = $CGI::XHTML = 42;

use SQL::Translator::Schema::Constants;

# -------------------------------------------------------------------
# Main entry point.  Returns a string containing HTML.
# -------------------------------------------------------------------
sub produce {
    my $t           = shift;
    my $args        = $t->producer_args;
    my $schema      = $t->schema;
    my $schema_name = $schema->name || 'Schema';
    my $title       = $args->{'title'} || "Description of $schema_name";
    my $wrap        = ! (defined $args->{'nowrap'}
                               ? $args->{'nowrap'}
                               : $NOWRAP);
    my $linktable   = ! (defined $args->{'nolinktable'}
                               ? $args->{'nolinktable'}
                               : $NOLINKTABLE);
    my %stylesheet  = defined $args->{'stylesheet'}
                    ? ( -style => { src => $args->{'stylesheet'} } )
                    : ( );
    my @html;
    my $q           = defined $args->{'pretty'}
                    ? do { require CGI::Pretty;
                            import CGI::Pretty;
                                   CGI::Pretty->new }
                    : do { require CGI;
                            import CGI; 
                                   CGI->new };
    my ($table, @table_names);

    if ($wrap) {
        push @html,
            $q->start_html({
                -title => $title,
                %stylesheet,
                -meta => { generator => $NAME },
            }),
            $q->h1({ -class => 'SchemaDescription' }, $title),
            $q->hr;
    }

    @table_names = grep { length $_->name } $schema->get_tables; 

    if ($linktable) {
        # Generate top menu, with links to full table information
        my $count = scalar(@table_names);
        $count = sprintf "%d table%s", $count, $count == 1 ? '' : 's';

        # Leading table of links
        push @html, 
            $q->comment("Table listing ($count)"),
            $q->a({ -name => 'top' }),
            $q->start_table({ -width => '100%', -class => 'LinkTable'}),

            # XXX This needs to be colspan="$#{$table->fields}" class="LinkTableHeader"
            $q->Tr(
                $q->td({ -class => 'LinkTableCell' },
                    $q->h2({ -class => 'LinkTableTitle' },
                        'Tables'
                    ),
                ),
            );

        for my $table (@table_names) {
            my $table_name = $table->name;
            push @html, 
                $q->comment("Start link to table '$table_name'"),
                $q->Tr({ -class => 'LinkTableRow' },
                    $q->td({ -class => 'LinkTableCell' },
                        qq[<a id="${table_name}-link" href="#$table_name">$table_name</a>]
                    )
                ),
                $q->comment("End link to table '$table_name'");
        }
        push @html, $q->end_table;
    }

    for my $table ($schema->get_tables) {
        my $table_name = $table->name       or next;
        my @fields     = $table->get_fields or next;
        push @html,
            $q->comment("Starting table '$table_name'"),
            $q->a({ -name => $table_name }),
            $q->table({ -class => 'TableHeader', -width => '100%' },
                $q->Tr({ -class => 'TableHeaderRow' },
                    $q->td({ -class => 'TableHeaderCell' }, $q->h3($table_name)),
                        qq[<a name="$table_name">],
                    $q->td({ -class => 'TableHeaderCell', -align => 'right' },
                        qq[<a href="#top">Top</a>]
                    )
                )
            );

        if ( my @comments = map { $_ ? $_ : () } $table->comments ) {
            push @html,
                $q->b("Comments:"),
                    $q->br,
                    $q->em(map { $q->br, $_ } @comments);
        }

        #
        # Fields
        #
        push @html,
            $q->start_table({ -border => 1 }),
                $q->Tr(
                    $q->th({ -class => 'FieldHeader' },
                           [ 
                            'Field Name', 
                            'Data Type', 
                            'Size', 
                            'Default Value', 
                            'Other', 
                            'Foreign Key' 
                           ]
                    ) 
                );

        my $i = 0;
        for my $field ( @fields ) {
            my $name      = $field->name      || '';
               $name      = qq[<a name="$table_name-$name">$name</a>];
            my $data_type = $field->data_type || '';
            my $size      = defined $field->size ? $field->size : '';
            my $default   = defined $field->default_value 
                            ? $field->default_value : '';
            my $comment   = $field->comments  || '';
            my $fk        = '';

            if ($field->is_foreign_key) {
                my $c         = $field->foreign_key_reference;
                my $ref_table = $c->reference_table       || '';
                my $ref_field = ($c->reference_fields)[0] || '';
                $fk           = 
                qq[<a href="#$ref_table-$ref_field">$ref_table.$ref_field</a>];
            }

            my @other = ();
            push @other, 'PRIMARY KEY' if $field->is_primary_key;
            push @other, 'UNIQUE'      if $field->is_unique;
            push @other, 'NOT NULL'    unless $field->is_nullable;
            push @other, $comment      if $comment;
            my $class = $i++ % 2 ? 'even' : 'odd';
            push @html,
                $q->Tr(
                    { -class => "tr-$class" },
                    $q->td({ -class => "FieldCellName" }, $name),
                    $q->td({ -class => "FieldCellType" }, $data_type),
                    $q->td({ -class => "FieldCellSize" }, $size),
                    $q->td({ -class => "FieldCellDefault" }, $default),
                    $q->td({ -class => "FieldCellOther" }, join(', ', @other)),
                    $q->td({ -class => "FieldCellFK" }, $fk),
                );
        }
        push @html, $q->end_table;

        #
        # Indices
        #
        if ( my @indices = $table->get_indices ) {
            push @html, 
                $q->h3('Indices'),
                $q->start_table({ -border => 1 }),
                    $q->Tr({ -class => 'IndexRow' },
                        $q->th([ 'Name', 'Fields' ]) 
                    );

            for my $index ( @indices ) {
                my $name   = $index->name || '';
                my $fields = join( ', ', $index->fields ) || '';

                push @html,
                    $q->Tr({ -class => 'IndexCell' },
                        $q->td( [ $name, $fields ] )
                    );
            }

            push @html, $q->end_table;
        }

        #
        # Constraints
        #
        my @constraints = 
            grep { $_->type ne PRIMARY_KEY } $table->get_constraints;
        if ( @constraints ) {
            push @html, 
                $q->h3('Constraints'),
                $q->start_table({ -border => 1 }),
                    $q->Tr({ -class => 'IndexRow' },
                        $q->th([ 'Type', 'Fields' ]) 
                    );

            for my $c ( @constraints ) {
                my $type   = $c->type || '';
                my $fields = join( ', ', $c->fields ) || '';

                push @html,
                    $q->Tr({ -class => 'IndexCell' },
                        $q->td( [ $type, $fields ] )
                    );
            }

            push @html, $q->end_table;
        }

        push @html, $q->hr;
    }

    my $sqlt_version = $t->version;
    if ($wrap) {
        push @html,
            qq[Created by <a href="http://sqlfairy.sourceforge.net">],
            qq[SQL::Translator $sqlt_version</a>],
            $q->end_html;
    }


    return join "\n", @html;
}

1;

# -------------------------------------------------------------------
# Always be ready to speak your mind,
# and a base man will avoid you.
# William Blake
# -------------------------------------------------------------------

=head1 NAME

SQL::Translator::Producer::HTML - HTML producer for SQL::Translator

=head1 SYNOPSIS

  use SQL::Translator::Producer::HTML;

=head1 DESCRIPTION

Creates an HTML document describing the tables.

The HTML produced is composed of a number of tables:

=over 4

=item Links

A link table sits at the top of the output, and contains anchored
links to elements in the rest of the document.

If the I<nolinktable> producer arg is present, then this table is not
produced.

=item Tables

Each table in the schema has its own HTML table.  The top row is a row
of E<lt>thE<gt> elements, with a class of B<FieldHeader>; these
elements are I<Field Name>, I<Data Type>, I<Size>, I<Default Value>,
I<Other> and I<Foreign Key>.  Each successive row describes one field
in the table, and has a class of B<FieldCell$item>, where $item id
corresponds to the label of the column.  For example:

    <tr>
        <td class="FieldCellName"><a name="random-id">id</a></td>
        <td class="FieldCellType">int</td>
        <td class="FieldCellSize">11</td>
        <td class="FieldCellDefault"></td>
        <td class="FieldCellOther">PRIMARY KEY, NOT NULL</td>
        <td class="FieldCellFK"></td>
    </tr>

    <tr>
        <td class="FieldCellName"><a name="random-foo">foo</a></td>
        <td class="FieldCellType">varchar</td>
        <td class="FieldCellSize">255</td>
        <td class="FieldCellDefault"></td>
        <td class="FieldCellOther">NOT NULL</td>
        <td class="FieldCellFK"></td>
    </tr>

    <tr>
        <td class="FieldCellName"><a name="random-updated">updated</a></td>
        <td class="FieldCellType">timestamp</td>
        <td class="FieldCellSize">0</td>
        <td class="FieldCellDefault"></td>
        <td class="FieldCellOther"></td>
        <td class="FieldCellFK"></td>
    </tr>

=back

Unless the I<nowrap> producer arg is present, the HTML will be
enclosed in a basic HTML header and footer.

If the I<pretty> producer arg is present, the generated HTML will be
nicely spaced and human-readable.  Otherwise, it will have very little
insignificant whitespace and be generally smaller.


=head1 AUTHORS

Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
Darren Chamberlain E<lt>darren@cpan.orgE<gt>.

=cut
Commit	Line	Data
aca7d777	1	package SQL::Translator::Producer::HTML;
	2
	3	# -------------------------------------------------------------------
821a0fde	4	# $Id$
aca7d777	5	# -------------------------------------------------------------------
977651a5	6	# Copyright (C) 2002-4 SQLFairy Authors
aca7d777	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;
a11fbaea	24	use Data::Dumper;
64e36ec8	25	use vars qw($VERSION $NOWRAP $NOLINKTABLE $NAME);
64e36ec8	26
821a0fde	27	$VERSION = sprintf "%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/;
64e36ec8	28	$NAME = join ', ', __PACKAGE__, $VERSION;
	29	$NOWRAP = 0 unless defined $NOWRAP;
	30	$NOLINKTABLE = 0 unless defined $NOLINKTABLE;
	31
	32	# Emit XHTML by default
	33	$CGI::XHTML = $CGI::XHTML = 42;
aca7d777	34
aca7d777	35	use SQL::Translator::Schema::Constants;
aca7d777	36
aca7d777	37	# -------------------------------------------------------------------
64e36ec8	38	# Main entry point. Returns a string containing HTML.
64e36ec8	39	# -------------------------------------------------------------------
aca7d777	40	sub produce {
aca7d777	41	my $t = shift;
84474a81	42	my $args = $t->producer_args;
aca7d777	43	my $schema = $t->schema;
aca7d777	44	my $schema_name = $schema->name \|\| 'Schema';
84474a81	45	my $title = $args->{'title'} \|\| "Description of $schema_name";
64e36ec8	46	my $wrap = ! (defined $args->{'nowrap'}
	47	? $args->{'nowrap'}
	48	: $NOWRAP);
	49	my $linktable = ! (defined $args->{'nolinktable'}
	50	? $args->{'nolinktable'}
	51	: $NOLINKTABLE);
	52	my %stylesheet = defined $args->{'stylesheet'}
	53	? ( -style => { src => $args->{'stylesheet'} } )
	54	: ( );
	55	my @html;
1ea530d4	56	my $q = defined $args->{'pretty'}
29ecbf4e	57	? do { require CGI::Pretty;
	58	import CGI::Pretty;
	59	CGI::Pretty->new }
	60	: do { require CGI;
	61	import CGI;
	62	CGI->new };
64e36ec8	63	my ($table, @table_names);
	64
	65	if ($wrap) {
	66	push @html,
	67	$q->start_html({
	68	-title => $title,
	69	%stylesheet,
	70	-meta => { generator => $NAME },
c012e81a	71	}),
64e36ec8	72	$q->h1({ -class => 'SchemaDescription' }, $title),
64e36ec8	73	$q->hr;
	74	}
	75
	76	@table_names = grep { length $_->name } $schema->get_tables;
aca7d777	77
64e36ec8	78	if ($linktable) {
	79	# Generate top menu, with links to full table information
	80	my $count = scalar(@table_names);
	81	$count = sprintf "%d table%s", $count, $count == 1 ? '' : 's';
aca7d777	82
64e36ec8	83	# Leading table of links
	84	push @html,
	85	$q->comment("Table listing ($count)"),
a3de76be	86	$q->a({ -name => 'top' }),
a3de76be	87	$q->start_table({ -width => '100%', -class => 'LinkTable'}),
64e36ec8	88
	89	# XXX This needs to be colspan="$#{$table->fields}" class="LinkTableHeader"
	90	$q->Tr(
	91	$q->td({ -class => 'LinkTableCell' },
	92	$q->h2({ -class => 'LinkTableTitle' },
	93	'Tables'
	94	),
	95	),
	96	);
ad02944a	97
d8b098e5	98	for my $table (@table_names) {
64e36ec8	99	my $table_name = $table->name;
	100	push @html,
	101	$q->comment("Start link to table '$table_name'"),
	102	$q->Tr({ -class => 'LinkTableRow' },
	103	$q->td({ -class => 'LinkTableCell' },
	104	qq[<a id="${table_name}-link" href="#$table_name">$table_name</a>]
	105	)
	106	),
	107	$q->comment("End link to table '$table_name'");
ad02944a	108	}
64e36ec8	109	push @html, $q->end_table;
ad02944a	110	}
ad02944a	111
64e36ec8	112	for my $table ($schema->get_tables) {
84474a81	113	my $table_name = $table->name or next;
aca7d777	114	my @fields = $table->get_fields or next;
64e36ec8	115	push @html,
a3de76be	116	$q->comment("Starting table '$table_name'"),
a3de76be	117	$q->a({ -name => $table_name }),
64e36ec8	118	$q->table({ -class => 'TableHeader', -width => '100%' },
	119	$q->Tr({ -class => 'TableHeaderRow' },
	120	$q->td({ -class => 'TableHeaderCell' }, $q->h3($table_name)),
	121	qq[<a name="$table_name">],
	122	$q->td({ -class => 'TableHeaderCell', -align => 'right' },
	123	qq[<a href="#top">Top</a>]
	124	)
	125	)
	126	);
aca7d777	127
84474a81	128	if ( my @comments = map { $_ ? $_ : () } $table->comments ) {
64e36ec8	129	push @html,
	130	$q->b("Comments:"),
	131	$q->br,
	132	$q->em(map { $q->br, $_ } @comments);
a11fbaea	133	}
a11fbaea	134
aca7d777	135	#
	136	# Fields
	137	#
64e36ec8	138	push @html,
a3de76be	139	$q->start_table({ -border => 1 }),
64e36ec8	140	$q->Tr(
	141	$q->th({ -class => 'FieldHeader' },
	142	[
	143	'Field Name',
	144	'Data Type',
	145	'Size',
	146	'Default Value',
	147	'Other',
	148	'Foreign Key'
	149	]
	150	)
	151	);
aca7d777	152
3d4edd30	153	my $i = 0;
aca7d777	154	for my $field ( @fields ) {
84474a81	155	my $name = $field->name \|\| '';
aca7d777	156	$name = qq[<a name="$table_name-$name">$name</a>];
84474a81	157	my $data_type = $field->data_type \|\| '';
	158	my $size = defined $field->size ? $field->size : '';
	159	my $default = defined $field->default_value
	160	? $field->default_value : '';
	161	my $comment = $field->comments \|\| '';
	162	my $fk = '';
aca7d777	163
64e36ec8	164	if ($field->is_foreign_key) {
84474a81	165	my $c = $field->foreign_key_reference;
	166	my $ref_table = $c->reference_table \|\| '';
	167	my $ref_field = ($c->reference_fields)[0] \|\| '';
	168	$fk =
aca7d777	169	qq[<a href="#$ref_table-$ref_field">$ref_table.$ref_field</a>];
	170	}
	171
84474a81	172	my @other = ();
aca7d777	173	push @other, 'PRIMARY KEY' if $field->is_primary_key;
	174	push @other, 'UNIQUE' if $field->is_unique;
	175	push @other, 'NOT NULL' unless $field->is_nullable;
ad02944a	176	push @other, $comment if $comment;
3d4edd30	177	my $class = $i++ % 2 ? 'even' : 'odd';
64e36ec8	178	push @html,
64e36ec8	179	$q->Tr(
3d4edd30	180	{ -class => "tr-$class" },
64e36ec8	181	$q->td({ -class => "FieldCellName" }, $name),
	182	$q->td({ -class => "FieldCellType" }, $data_type),
	183	$q->td({ -class => "FieldCellSize" }, $size),
	184	$q->td({ -class => "FieldCellDefault" }, $default),
	185	$q->td({ -class => "FieldCellOther" }, join(', ', @other)),
	186	$q->td({ -class => "FieldCellFK" }, $fk),
	187	);
aca7d777	188	}
64e36ec8	189	push @html, $q->end_table;
aca7d777	190
	191	#
	192	# Indices
	193	#
	194	if ( my @indices = $table->get_indices ) {
64e36ec8	195	push @html,
	196	$q->h3('Indices'),
	197	$q->start_table({ -border => 1 }),
	198	$q->Tr({ -class => 'IndexRow' },
	199	$q->th([ 'Name', 'Fields' ])
	200	);
aca7d777	201
aca7d777	202	for my $index ( @indices ) {
84474a81	203	my $name = $index->name \|\| '';
	204	my $fields = join( ', ', $index->fields ) \|\| '';
	205
64e36ec8	206	push @html,
	207	$q->Tr({ -class => 'IndexCell' },
	208	$q->td( [ $name, $fields ] )
	209	);
aca7d777	210	}
aca7d777	211
64e36ec8	212	push @html, $q->end_table;
aca7d777	213	}
aca7d777	214
a3de76be	215	#
	216	# Constraints
	217	#
	218	my @constraints =
	219	grep { $_->type ne PRIMARY_KEY } $table->get_constraints;
	220	if ( @constraints ) {
	221	push @html,
	222	$q->h3('Constraints'),
	223	$q->start_table({ -border => 1 }),
	224	$q->Tr({ -class => 'IndexRow' },
	225	$q->th([ 'Type', 'Fields' ])
	226	);
	227
	228	for my $c ( @constraints ) {
	229	my $type = $c->type \|\| '';
	230	my $fields = join( ', ', $c->fields ) \|\| '';
	231
	232	push @html,
	233	$q->Tr({ -class => 'IndexCell' },
	234	$q->td( [ $type, $fields ] )
	235	);
	236	}
	237
	238	push @html, $q->end_table;
	239	}
	240
64e36ec8	241	push @html, $q->hr;
aca7d777	242	}
aca7d777	243
a3de76be	244	my $sqlt_version = $t->version;
64e36ec8	245	if ($wrap) {
	246	push @html,
	247	qq[Created by <a href="http://sqlfairy.sourceforge.net">],
a3de76be	248	qq[SQL::Translator $sqlt_version</a>],
64e36ec8	249	$q->end_html;
64e36ec8	250	}
aca7d777	251
64e36ec8	252
64e36ec8	253	return join "\n", @html;
aca7d777	254	}
	255
	256	1;
	257
	258	# -------------------------------------------------------------------
	259	# Always be ready to speak your mind,
	260	# and a base man will avoid you.
	261	# William Blake
	262	# -------------------------------------------------------------------
	263
	264	=head1 NAME
	265
	266	SQL::Translator::Producer::HTML - HTML producer for SQL::Translator
	267
	268	=head1 SYNOPSIS
	269
	270	use SQL::Translator::Producer::HTML;
	271
	272	=head1 DESCRIPTION
	273
	274	Creates an HTML document describing the tables.
	275
64e36ec8	276	The HTML produced is composed of a number of tables:
	277
	278	=over 4
	279
	280	=item Links
	281
	282	A link table sits at the top of the output, and contains anchored
	283	links to elements in the rest of the document.
	284
	285	If the I<nolinktable> producer arg is present, then this table is not
	286	produced.
	287
	288	=item Tables
	289
	290	Each table in the schema has its own HTML table. The top row is a row
	291	of E<lt>thE<gt> elements, with a class of B<FieldHeader>; these
	292	elements are I<Field Name>, I<Data Type>, I<Size>, I<Default Value>,
	293	I<Other> and I<Foreign Key>. Each successive row describes one field
	294	in the table, and has a class of B<FieldCell$item>, where $item id
	295	corresponds to the label of the column. For example:
	296
	297	<tr>
	298	<td class="FieldCellName"><a name="random-id">id</a></td>
	299	<td class="FieldCellType">int</td>
	300	<td class="FieldCellSize">11</td>
	301	<td class="FieldCellDefault"></td>
	302	<td class="FieldCellOther">PRIMARY KEY, NOT NULL</td>
	303	<td class="FieldCellFK"></td>
	304	</tr>
	305
	306	<tr>
	307	<td class="FieldCellName"><a name="random-foo">foo</a></td>
	308	<td class="FieldCellType">varchar</td>
	309	<td class="FieldCellSize">255</td>
	310	<td class="FieldCellDefault"></td>
	311	<td class="FieldCellOther">NOT NULL</td>
	312	<td class="FieldCellFK"></td>
	313	</tr>
	314
	315	<tr>
	316	<td class="FieldCellName"><a name="random-updated">updated</a></td>
	317	<td class="FieldCellType">timestamp</td>
	318	<td class="FieldCellSize">0</td>
	319	<td class="FieldCellDefault"></td>
	320	<td class="FieldCellOther"></td>
	321	<td class="FieldCellFK"></td>
	322	</tr>
	323
	324	=back
	325
	326	Unless the I<nowrap> producer arg is present, the HTML will be
	327	enclosed in a basic HTML header and footer.
	328
	329	If the I<pretty> producer arg is present, the generated HTML will be
	330	nicely spaced and human-readable. Otherwise, it will have very little
	331	insignificant whitespace and be generally smaller.
	332
	333
977651a5	334	=head1 AUTHORS
aca7d777	335
64e36ec8	336	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
977651a5	337	Darren Chamberlain E<lt>darren@cpan.orgE<gt>.
aca7d777	338
aca7d777	339	=cut