File Coverage

blib/lib/SQL/Translator/Producer/HTML.pm

Criterion	Covered	Total	%
statement	12	93	12.9
branch	0	44	0.0
condition	0	23	0.0
subroutine	4	5	80.0
pod	0	1	0.0
total	16	166	9.6

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

use strict;
use warnings;
use Data::Dumper;

our $VERSION     = '1.66';
our $NAME        = __PACKAGE__;
our $NOWRAP      = 0 unless defined $NOWRAP;
our $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[$table_name])),
          $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[],
            $q->td({ -class => 'TableHeaderCell', -align => 'right' }, qq[Top])
          )
        );

    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[$name];
      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[$ref_table.$ref_field];
      }

      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 ],
        qq[SQL::Translator $sqlt_version],
        $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 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 EthE elements, with a class of B; these
elements are I, I, I, I,
I and I.  Each successive row describes one field
in the table, and has a class of B, where $item id
corresponds to the label of the column.  For example:




























=back

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

If the I 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 Youens-Clark [e-mail],
Darren Chamberlain [e-mail].

=cut