File Coverage

lib/Parse/Dia/SQL/Output/HTML.pm

Criterion	Covered	Total	%
statement	21	21	100.0
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	28	28	100.0

package Parse::Dia::SQL::Output::HTML;

# $Id: $

=pod

=head1 NAME

Parse::Dia::SQL::Output::HTML - Create HTML documentation.

=head1 SYNOPSIS

    use Parse::Dia::SQL;
    my $dia = Parse::Dia::SQL->new(
      file => 'foo.dia',
      db   => 'html' [ , htmlformat => {formatfile} ]
    );
    print $dia->get_sql();

=head1 DESCRIPTION

This sub-class creates HTML formatted database documentation.

HTML formatting is controlled by templates selected with the optional
I parameter which supplies a format file. See L
formats"> for more.

The generated HTML is intended to be useful rather than beautiful.

This sub-class follows the same structure as the rdbms output
sub-classes with the intent of maintaining consistency, even though
this give less than optimum efficiency.

=cut

use warnings;
use strict;

use Text::Table;
use Data::Dumper;
use File::Spec::Functions qw(catfile);

use lib q{lib};
use base q{Parse::Dia::SQL::Output};    # extends
use Config;

require Parse::Dia::SQL::Logger;
require Parse::Dia::SQL::Const;


=head2 new

The constructor.

Object names in HTML have no inherent limit. 64 has been arbitrarily chosen.

=cut

sub new {
  my ( $class, %param ) = @_;
  my $self = {};

  # Set defaults for sqlite
  $param{db} = q{html};
  $param{object_name_max_length} = $param{object_name_max_length} || 64;
  $param{htmlformat} = $param{htmlformat} || '';

  $self = $class->SUPER::new( %param );
  bless( $self, $class );

  $self->{dbdata} = {}; # table data, keyed by tablename
  $self->{htmltemplate} = {}; # html template elements
  $self->set_html_template($param{htmlformat}); # find the template elements based on the selected format

  return $self;
}

=head2 get_sql

Return all sql documentation.

First build the data structures:

  schema create
  view create
  permissions create
  inserts
  associations create  (indices first, then foreign keys)

Then generate the output:

  html start
  html comments
  body start
  generate main html
  body end
  html end

=cut

sub get_sql {
  my $self = shift;

  ## no critic (NoWarnings)
  no warnings q{uninitialized};

  $self->get_schema_create();
  $self->get_view_create();
  $self->get_permissions_create();
  $self->get_inserts();
  $self->get_associations_create();

  my $html = ''
  . $self->_get_preamble()
  . $self->_get_comment()
  . $self->get_smallpackage_pre_sql()
  . $self->generate_html()
  . $self->get_smallpackage_post_sql()
  . $self->_get_postscript()
  ;

  return $html;
}

=head2 _get_preamble

HTML Header

=cut
sub _get_preamble {
  my $self = shift;
  my $files_word =
    (scalar(@{ $self->{files} }) > 1)
    ? q{Input files}
    : q{Input file};

  my $data = $self->{htmltemplate}{htmlpreamble};

  # File name
  my $value = $self->{files}[0];
  $data =~ s/{filename}/$value/mgi;

  # todo: meta tags?
  return $data
}


=head2 _get_comment

Comment for HTML Header

=cut

sub _get_comment {
  my $self = shift;
  my $files_word =
    (scalar(@{ $self->{files} }) > 1)
    ? q{Input files}
    : q{Input file};

  $self->{gentime} = scalar localtime();

  my @arr = (
    [ q{Parse::SQL::Dia}, qq{version $Parse::Dia::SQL::VERSION} ],
    [ q{Documentation},   q{http://search.cpan.org/dist/Parse-Dia-SQL/} ],
    [ q{Environment},     qq{Perl $], $^X} ],
    [ q{Architecture},    qq{$Config{archname}} ],
    [ q{Target Database}, $self->{db} ],
    [ $files_word,     join(q{, }, @{ $self->{files} }) ],
    [ q{Generated at}, $self->{gentime} ],
  );

  $self->{filename} = join(q{, }, @{ $self->{files} });

  my $value = '';
  my $data = $self->{htmltemplate}{htmlcomment};
  my $tb = Text::Table->new();
  $tb->load(@arr);

  $value = scalar $tb->table();
  $data =~ s/{htmlcomment}/$value/mgi;

  return $data;
}

=head2 get_smallpackage_pre_sql

HTML Body start

=cut
sub get_smallpackage_pre_sql {
  my $self = shift;
  my $data;

  $data = $self->{htmltemplate}{htmlstartbody};

  return $data
}

=head2 get_smallpackage_post_sql

HTML Body close

=cut
sub get_smallpackage_post_sql {
  my $self = shift;
  my $data;

  $data = $self->{htmltemplate}{htmlendbody};
  $data =~ s/{gentime}/$self->{gentime}/mgi;

  return $data
}

=head2 _get_postscript

HTML close

=cut

sub _get_postscript {
  my $self = shift;
  my $data = '';

  $data = $self->{htmltemplate}{htmlend};

  return $data
}

=head2 _get_create_table_sql

Extracts the documentation details for a single table.

=cut

sub _get_create_table_sql {
  my ( $self, $table ) = @_;
  #my $sqlstr = '';
  my $temp;
  my $comment;
  my $tablename;
  my $update;
  my $primary_keys = '';
  my $order = 0;

  my $tabletemplate = '';
  my $tablerowemplate = '';
  my $tabledata = '';
  my $tablerowdata = '';

  # Table name
  $tablename = $table->{name};
  $self->{'dbdata'}{$tablename} = {};

  # Comments 1 - strip the autoupdate bits
  $comment = $table->{comment};
  if ( !defined( $comment ) ) { $comment = ''; }
  if ( $comment ne '' ) {
    $comment =~ s/\n//g;
    $comment =~ s///mgi;
  }

  # Comments 2 - just the autoupdate bits
  $update = $table->{comment};
  if ( !defined( $update ) ) { $update = ''; }
  if ( $update =~ //mi ) {
    $update  = $3;    # update code
    }

  # Set up build the table documentation
  $self->{'dbdata'}{$tablename}{'name'} = $tablename;
  $self->{'dbdata'}{$tablename}{'comment'} = $comment;
  $self->{'dbdata'}{$tablename}{'autoupdate'} = $update;
  $self->{'dbdata'}{$tablename}{'fields'} = {}; # field list, keyed by field name
  $self->{'dbdata'}{$tablename}{'keyfields'} = {}; # primary key fields
  $self->{'dbdata'}{$tablename}{'ref_by'} = {}; # tables that use this as a FK
  $self->{'dbdata'}{$tablename}{'ref_to'} = {}; # tables that this uses for FK
  $self->{'dbdata'}{$tablename}{'permissions'} = []; # permissions array
  $self->{'dbdata'}{$tablename}{'indices'} = {}; # indices keyed by index name

  # Fields
  # Check not null and primary key property for each column. Column
  # visibility is given in $columns[3]. A value of 2 in this field
  # signifies a primary key (which also must be defined as 'not null'.
  $tablerowdata = '';
  foreach my $column (@{ $table->{attList} }) {

    if (ref($column) ne 'ARRAY') {
      $self->{log}
        ->error(q{Error in view attList input - expect an ARRAY ref!});
      next COLUMN;
    }

    # Don't warn on uninitialized values here since there are lots
    # of them.

    ## no critic (ProhibitNoWarnings)
    no warnings q{uninitialized};

    # Field sequence:
    my ($col_name, $col_type, $col_val, $col_vis, $col_com) = @{$column};
    $self->{'dbdata'}{$tablename}{'fields'}{$col_name} = {
        'name'    => $col_name,
        'type'    => $col_type,
        'default' => $col_val,
        'comment' => $col_com,
        'order'   => $order,
    };
    $order ++;

    ## Add 'not null' if field is primary key
    if ($col_vis == 2) {
      $self->{'dbdata'}{$tablename}{'fields'}{$col_name}{'default'} = 'not null';
      $self->{'dbdata'}{$tablename}{'keyfields'}{$col_name} = 1;
    }
  }

  return '';
}

=head2 get_schema_drop

Do nothing

=cut

sub get_schema_drop {
  return '';
}

=head2 get_view_drop

Do nothing

=cut

sub get_view_drop {
 return '';
}

=head2 _get_fk_drop

Do nothing

=cut

sub _get_fk_drop {
  return '';
}

=head2 _get_drop_index_sql

Do nothing

=cut

sub _get_drop_index_sql {
  return '';
}

=head2 get_permissions_create

Permissions are formatted as C<{type} {name} to {list of roles}> where:

C is the operation C, C etc

C is the permission name C, C etc

C is the set of datbase roles affected.

=head3 Warning

Permissions are at best lightly tested (ie potentially buggy)

=cut

sub get_permissions_create {
  my $self   = shift;
  #my $sqlstr = '';
  #my $temparrayref;

  # Check classes
  return unless $self->_check_classes();

  # loop through classes looking for grants
  foreach my $table (@{ $self->{classes} }) {

    foreach my $operation (@{ $table->{ops} }) {

      if (ref($operation) ne 'ARRAY') {
        $self->{log}->error(
          q{Error in ops input - expect an ARRAY ref, got } . ref($operation));
        next OPERATION;
      }

      my ($opname, $optype, $colref) =
        ($operation->[0], $operation->[1], $operation->[2]);

      # 2nd element can be index, unique index, grant, etc
      next if (lc($optype) ne q{grant} and lc($optype) ne q{revoke} );
      # TODO:BUG in core code - should accecpt revoke or grant, not just grant

      # Add backticks if option is set and dbtype is correct
      my $tablename = $self->_quote_identifier($table->{name});

      my $temp = qq{$optype $opname to } . join(q{,}, @{$colref});
      push @{ $self->{'dbdata'}{$tablename}{'permissions'} }, $temp;
    }
  }

  return '';
}

=head2 get_permissions_drop

Do nothing

=cut

sub get_permissions_drop {
  return '';
}

=head2 _get_create_association_sql

Extracts the documentation for table relationships.

=cut

# Create sql for given association.
sub _get_create_association_sql {
  my ( $self, $association ) = @_;
  my $temp;

  # Sanity checks on input
  if ( ref( $association ) ne 'ARRAY' ) {
    $self->{log}
      ->error( q{Error in association input - cannot create association sql!} );
    return;
  }

  my (
    $table_name, $constraint_name, $key_column,
    $ref_table,  $ref_column,      $constraint_action
  ) = @{$association};

  $self->{'dbdata'}{$ref_table}{'ref_by'}{$constraint_name} = {'table' => $table_name, 'key' => $key_column, 'fk' => $ref_column, 'action' => $constraint_action};
  $self->{'dbdata'}{$table_name}{'ref_to'}{$constraint_name} = {'table' => $ref_table, 'key' => $ref_column, 'fk' => $key_column, 'action' => $constraint_action};

  return '';
}


=head2 _get_create_index_sql

Extracts the documentation for table indices.

=cut

# Create sql for all indices for given table.
sub _get_create_index_sql {
  my ($self, $table) = @_;
  my $sqlstr = q{};

  # Sanity checks on input
  if (ref($table) ne 'HASH') {
    $self->{log}->error(q{Error in table input - cannot create index sql!});
    return;
  }

OPERATION:
  foreach my $operation (@{ $table->{ops} }) {

    if (ref($operation) ne 'ARRAY') {
      $self->{log}->error(
        q{Error in ops input - expect an ARRAY ref, got } . ref($operation));
      next OPERATION;
    }

    # Extract elements (the stereotype is not in use)
    my ($opname, $optype, $colref, $opstereotype, $opcomment) = (
      $operation->[0], $operation->[1], $operation->[2],
      $operation->[3], $operation->[4]
    );

    # 2nd element can be index, unique index, grant, etc.
    # Accept "index" only in this context.
    if ($optype !~ qr/^(unique )?index$/i) {
      $self->{log}->debug(qq{Skipping optype '$optype' - not (unique) index});
      next OPERATION;
    }

    my $idx_opt =
      (defined $opcomment && $opcomment ne q{})
      ? $opcomment
      : join(q{,}, @{ $self->{index_options} });

    $optype =~ s/index(\w*)//; # remove the 'index' word, leaving unique
    $self->{'dbdata'}{$table->{name}}{'indices'}{$opname} = {'columns' => join(q{, }, @{$colref}), 'comment' => $idx_opt, 'type' => $optype};
    # Use operation comment as index option if defined, otherwise
    # use default (if any)
  }
  return '';
}


=head2 generate_html

Do the output

=cut

sub generate_html {
  my $self = shift;
  my $html = '';
  my $table = '';
  my $tabledata = '';
  my $rowdata = '';
  my $field = '';
  my $temp = '';
  my $value = '';
  my $sep  = '';
  #my $temparray;
  my $fieldblank = $self->{htmltemplate}{fieldblank};

  $html = '';
  $sep = '';
  $rowdata = '';
  # Table list
  foreach $table (sort keys %{$self->{'dbdata'}}) {
    $tabledata = $self->{htmltemplate}{tablelistitem};

    # Table name
    $temp = $self->{'dbdata'}{$table}{'name'} || $fieldblank;
    $tabledata =~ s/{tablename}/$temp/mgi;

    # Table comment
    $value = $self->{'dbdata'}{$table}{'comment'};
    if ( $value) {
      $temp = $self->{htmltemplate}{tablecommentlist};
      $temp =~ s/{comment}/$value/mgi;
    }
    else {
      $temp = $fieldblank; # list context
    }
    $tabledata =~ s/{tablecomment}/$temp/mgi;

    $rowdata .= $sep . $tabledata;
    $sep = $self->{htmltemplate}{tablelistsep};
  }
  $temp = $self->{htmltemplate}{tablelist};
  $temp =~ s/{tablelist}/$rowdata/mgi;
  $value = $self->{filename};
  $temp =~ s/{filename}/$value/mgi;
  $html .= $temp;


  # Table details
  $temp = $self->{htmltemplate}{tablestart};
  $html .= $temp;
  foreach $table (sort keys %{$self->{'dbdata'}}) {
    $tabledata = $self->{htmltemplate}{table};

    # Table name
    $temp = $self->{'dbdata'}{$table}{'name'};
    $tabledata =~ s/{tablename}/$temp/mgi;

    # Table comment
    $value = $self->{'dbdata'}{$table}{'comment'};
    if ( $value) {
      $temp = $self->{htmltemplate}{tablecomment};
      $temp =~ s/{comment}/$value/mgi;
    }
    else {
      $temp = '';
    }
    $tabledata =~ s/{tablecomment}/$temp/mgi;

    # Autoupdate
    $value = $self->{'dbdata'}{$table}{'autoupdate'};
    if ( $value) {
      $temp = $self->{htmltemplate}{autoupdate};
      $temp =~ s/{autoupdate}/$value/mgi;
    }
    else {
      $temp = '';
    }
    $tabledata =~ s/{autoupdate}/$temp/mgi;

    # Field data
    $rowdata = '';
    # PK fields first - in diagram order
    foreach $field (sort {$self->{'dbdata'}{$table}{'fields'}{$a}{'order'} <=> $self->{'dbdata'}{$table}{'fields'}{$b}{'order'}} keys %{$self->{'dbdata'}{$table}{'keyfields'}}) {
      $temp = $self->{htmltemplate}{tablekeyrow};
      $value = $self->{'dbdata'}{$table}{'fields'}{$field}{'name'} || $fieldblank;
      $temp =~ s/{name}/$value/mgi;
      $value = $self->{'dbdata'}{$table}{'fields'}{$field}{'type'} || $fieldblank;
      $temp =~ s/{type}/$value/mgi;
      $value = $self->{'dbdata'}{$table}{'fields'}{$field}{'default'} || $fieldblank;
      $temp =~ s/{default}/$value/mgi;
      $value = $self->{'dbdata'}{$table}{'fields'}{$field}{'comment'} || $fieldblank;
      $value =~ s/\n//gmi;
      $temp =~ s/{comment}/$value/mgi;
      $rowdata .= $temp;
    }

    # Other fields - in diagram order
    foreach $field (sort {$self->{'dbdata'}{$table}{'fields'}{$a}{'order'} <=> $self->{'dbdata'}{$table}{'fields'}{$b}{'order'}} keys %{$self->{'dbdata'}{$table}{'fields'}}) {
      if ( not defined($self->{'dbdata'}{$table}{'keyfields'}{$field})){
        $temp = $self->{htmltemplate}{tablerow};
        $value = $self->{'dbdata'}{$table}{'fields'}{$field}{'name'} || $fieldblank;
        $temp =~ s/{name}/$value/mgi;
        $value = $self->{'dbdata'}{$table}{'fields'}{$field}{'type'} || $fieldblank;
        $temp =~ s/{type}/$value/mgi;
        $value = $self->{'dbdata'}{$table}{'fields'}{$field}{'default'} || $fieldblank;
        $temp =~ s/{default}/$value/mgi;
        $value = $self->{'dbdata'}{$table}{'fields'}{$field}{'comment'} || $fieldblank;
        $value =~ s/\n//gmi;
        $temp =~ s/{comment}/$value/mgi;
        $rowdata .= $temp;
      }
    }
    $tabledata =~ s/{tablerowdata}/$rowdata/mgi;

    # References
    $rowdata = '';
    $sep = '';
    foreach $field (sort keys %{$self->{'dbdata'}{$table}{'ref_by'}}) {
      $temp = $self->{htmltemplate}{refbyitem};
      $value = $self->{'dbdata'}{$table}{'ref_by'}{$field}{'table'};
      $temp =~ s/{tablename}/$value/mgi;
      $value = $self->{'dbdata'}{$table}{'ref_by'}{$field}{'key'};
      $temp =~ s/{key}/$value/mgi;
      $value = $self->{'dbdata'}{$table}{'ref_by'}{$field}{'fk'};
      $temp =~ s/{fk}/$value/mgi;
      $value = $self->{'dbdata'}{$table}{'ref_by'}{$field}{'action'};
      $temp =~ s/{action}/$value/mgi;
      $temp =~ s/{refname}/$field/mgi;
      $rowdata .= $sep . $temp;
      $sep = $self->{htmltemplate}{refbysep};
    }
    if ( $rowdata ) {
        $temp = $self->{htmltemplate}{refby};
        $temp =~ s/{refbylist}/$rowdata/mgi;
        $tabledata =~ s/{refby}/$temp/mgi;
    }
    else {
      $tabledata =~ s/{refby}//mgi;
    }

    $rowdata = '';
    $sep = '';
    foreach $field (sort keys %{$self->{'dbdata'}{$table}{'ref_to'}}) {
      $temp = $self->{htmltemplate}{reftoitem};
      $value = $self->{'dbdata'}{$table}{'ref_to'}{$field}{'table'};
      $temp =~ s/{tablename}/$value/mgi;
      $value = $self->{'dbdata'}{$table}{'ref_to'}{$field}{'key'};
      $temp =~ s/{key}/$value/mgi;
      $value = $self->{'dbdata'}{$table}{'ref_to'}{$field}{'fk'};
      $temp =~ s/{fk}/$value/mgi;
      $value = $self->{'dbdata'}{$table}{'ref_to'}{$field}{'action'};
      $temp =~ s/{action}/$value/mgi;
      $temp =~ s/{refname}/$field/mgi;
      $rowdata .= $sep . $temp;
      $sep = $self->{htmltemplate}{refbysep};
    }
    if ( $rowdata ) {
        $temp = $self->{htmltemplate}{refto};
        $temp =~ s/{reftolist}/$rowdata/mgi;
        $tabledata =~ s/{refto}/$temp/mgi;
    }
    else {
      $tabledata =~ s/{refto}//mgi;
    }

    # Indices
    $rowdata = '';
    $sep = '';
    foreach $field (sort keys %{$self->{'dbdata'}{$table}{'indices'}}) {
      $temp = $self->{htmltemplate}{indexitem};
      $temp =~ s/{tablename}/$table/mgi;
      $value = $self->{'dbdata'}{$table}{'indices'}{$field}{'columns'};
      $temp =~ s/{columns}/$value/mgi;
      $value = $self->{'dbdata'}{$table}{'indices'}{$field}{'comment'};
      $temp =~ s/{comment}/$value/mgi;
      $value = $self->{'dbdata'}{$table}{'indices'}{$field}{'type'};
      $temp =~ s/{type}/$value/mgi;
      $temp =~ s/{indexname}/$field/mgi;
      $rowdata .= $sep . $temp;
      $sep = $self->{htmltemplate}{indexsep};
    }
    if ( $rowdata ) {
        $temp = $self->{htmltemplate}{indices};
        $temp =~ s/{indexlist}/$rowdata/mgi;
        $tabledata =~ s/{indices}/$temp/mgi;
    }
    else {
      $tabledata =~ s/{indices}//mgi;
    }

    # Permissions
    $rowdata = '';
    $sep = '';
    if (scalar(@{ $self->{'dbdata'}{$table}{'permissions'} })) {
      foreach $field (@{ $self->{'dbdata'}{$table}{'permissions'} }) {
        $temp = $self->{htmltemplate}{permissionitem};
        $temp =~ s/{permission}/$field/mgi;
        $rowdata .= $sep . $temp;
        $sep = $self->{htmltemplate}{permissionsep};
      }
    }
    if ( $rowdata ) {
        $temp = $self->{htmltemplate}{permission};
        $temp =~ s/{permissionlist}/$rowdata/mgi;
        $tabledata =~ s/{permissions}/$temp/mgi;
    }
    else {
      $tabledata =~ s/{permissions}//mgi;
    }

    $html .= $tabledata;

  }

  return $html;
}



=head2 set_html_template

Set up the formatting template

Template elements use C<{placeholders}> to identify how the document should be built.

=cut

sub set_html_template {
  my $self = shift;
  my $format = shift;

  $format = lc($format);

  # Standard HTML bits
  $self->{htmltemplate}{htmlpreamble} = "\nDatabase documentation: {filename}";
  $self->{htmltemplate}{htmlcomment} = "\n\n";
  $self->{htmltemplate}{htmlstartbody} = '';
  $self->{htmltemplate}{htmlendbody} = 'Generated at {gentime}.';
  $self->{htmltemplate}{htmlend} = '';

  # List of tables
  $self->{htmltemplate}{tablelist} = <<"END";

Data Dictionary for {filename}
List of Tables
{tablelist}


END

  $self->{htmltemplate}{tablestart} =  "Table details\n";
  $self->{htmltemplate}{tablelistitem} =  "{tablename}";
  $self->{htmltemplate}{tablelistsep} = ', ';

  # Table: a single table details, mostly placeholders for individual elements
  $self->{htmltemplate}{table} = <<"END";
Table: {tablename}
{tablecomment}
{refto}
{refby}
 




772




 





 





 





 





 





 



 FieldTypeDefaultDescription 




773




 





 





 





 





 





 



 {tablerowdata} 




774

{tablerowdata}

{autoupdate}
{indices}
{permissions}

END

  # tablekeyrowtemplate - a single Primary Key row
  $self->{htmltemplate}{tablekeyrow} = '

  # tablerowtemplate - a single non-Key row
  $self->{htmltemplate}{tablerow} = '

  # comment - for the table comments (if any)
  $self->{htmltemplate}{tablecomment} = '{comment}';
  $self->{htmltemplate}{tablecommentlist} = '{comment}';

  # autoupdate
  $self->{htmltemplate}{autoupdate} = 'Automatically set:{autoupdate}';

  # References - a list of tables that refer to this one via foreign keys
  # Each is formatted with 'refbyitem', separated by 'refbysep'.
  $self->{htmltemplate}{refby} = 'Referenced by: {refbylist}';
  $self->{htmltemplate}{refbyitem} = "{tablename}"; #"{tablename}[{key}]";
  $self->{htmltemplate}{refbysep} = ', ';

  # References - a similar list of tables which which this one refers
  # Each is formatted with 'reftoitem', separated by 'reftosep'.
  $self->{htmltemplate}{refto} = 'References: {reftolist}';
  $self->{htmltemplate}{reftoitem} = "{tablename}"; # "{tablename}[{key}] ({fk}, {action})";
  $self->{htmltemplate}{reftosep} = ', '; # '';

  # Permissions - a list of permissions on this table
  # Each is formatted with 'permissionitem', separated by 'permissionsep'.
  $self->{htmltemplate}{permission} = 'Permissions{permissionlist}';
  $self->{htmltemplate}{permissionitem} = '{permission}';
  $self->{htmltemplate}{permissionsep} = '';

  # Indices - a list of indices on this table
  # Each is formatted with 'indexitem', separated by 'indexsep'.
  $self->{htmltemplate}{indices} = 'Indices{indexlist}';
  $self->{htmltemplate}{indexitem} = '{indexname}: {type} on {columns} {comment}';
  $self->{htmltemplate}{indexsep} = '';

  $self->{htmltemplate}{fieldblank} = ' ';

  # If we have a format parameter, try to read that HTML template elements from it, overriding the defaults

  if ( $format) {
    local $/=undef; # so we can slurp the whole file as one lump
    open my $fh, '<', $format or die "Couldn't open format file: '$format' $!\n";
    my $contents = <$fh>;
    close $fh;
    my $tag;
    my $htmlelement;
    while ($contents =~ m/\{(?:def\:)(.*?)(?:})(.*?)\{.def\:(\g1)/gsi ) {
      $tag = $1;
      $htmlelement = $2;
      $htmlelement =~s/\\n/\n/g; # Replace \n's with \n's
      $self->{htmltemplate}{$tag} = $htmlelement
   }
  }

  return;
}

1;

=head1 HTML Formats

The default format may be all you need.
If you want to create different HTML formats for different uses, create a format file
with template elements defined between C<{def:element}> and C<{/def:element}> markers.
You only need to define those elements that you want to be I from the defaults.

Any text outside the C<{def:element}> and C<{/def:element}> is ignored, so you can add comments without affecting the output.

Any C<\n> literals in the format file are replaced with newlines; although newlines in the generated HTML typically have
no effect on the layout, they can make the output easier for humans to read.


=head2 Template elements

=head3 htmlpreamble

The start of the html document.

I: filename

I: \nDatabase documentation: {filename}

=head3 htmlcomment

A generated comment at the start of the html document. This is the standard comment at the start of the SQL script.

I: htmlcomment

I: \n\n


=head3 htmlstartbody

The start body html tag.

I:


=head3 htmlendbody

The end body html tag.

I: gentime

I: Generated at {gentime}.


=head3 htmlend

The end html tag.

I:


=head3 tablelist

The bit at the top of the page which lists all the tables.
Each is formatted with L, separated by L.

I: tablelist (the assembled list of table), filename

I:

 Data Dictionary for {filename}
 List of Tables
 {tablelist}



=head3 tablelistitem

An individual element (table) in the table list

I: tablename, tablecomment

I: {tablename}


=head3 tablelistsep

Separator between individual elements in the table list.

I: C<, >


=head3 tablestart

Introduction to the table details

I: Table details

=head3 table

Details of one table.

I: tablename, comment, refto, refby, tablerowdata, autoupdate, indices, permissions.

I:

 Table: {tablename}
 {comment}
 {refto}
 {refby}
  




947




 





 





 





 





 





 



  FieldTypeDefaultDescription 




948




 





 





 





 





 





 



  {tablerowdata} 




949

 {tablerowdata}

 {autoupdate}
 {indices}
 {permissions}


=head3 tablekeyrow, tablerow

Details of an individual field (column) from the (table) in the table detail.

tablekeyrow is used for primary key fields, tablerow for other fields.

I: name, type, default, comment.

I B:

I B:


=head3 tablecomment

Table comments/description.

I: comment

I: {comment}

=head3 tablecommentlist

Table comments/description in a list context

I: comment

I: {comment}

=head3 autoupdate

Auto update code, if used.

I: autoupdate

I: Automatically set:{autoupdate}


=head3 refby, refto

References by - a list of tables that refer to this one via foreign keys.

References to - a list of tables to which this table refers via foreign keys.

The whole section is omitted if there are no references (including any static text).

I: refbylist, reftolist respectively.

I: B Referenced by: {refbylist}

I: B References: {reftolist}


=head3 refbyitem, reftoitem

A single item in the reference by list

I: tablename, key, fk, action, refname

Here I is the other table, I is the field in this table, I is the field in the other table,
I in the action on update/delete (such as cascade or update) and I is the name of the constraint.

I: {tablename}


=head3 refbysep, reftosep

Separator between references.

I: C<, >

=head3 indices

List of indices on this tables.

The whole section is omitted if there are no indices (including any static text).

I: indexlist

I: Indices{indexlist}

=head3 indexitem

A single item in the index list

I: tablename, columns, comment, type, indexname

Here I is the indexed (ie current) table, I is the set of columns in the index, I is the index comment if any,
I is 'unique' (or blank) and I is the name of the index.

I: {indexname}: {type} on {columns} {comment}

=head3 indexsep

Separator between indices.

I: C<>


=head3 permission

A list of permissions granted on this table.

I: permissionlist

I: Permissions{permissionlist}


=head3 permissionitem

A single permission in the list

I: permission

I: {permission}


=head3 permissionsep

Separator between permissions.

I:


=head3 fieldblank

Replacement character(s) for blank values. Default value is empty.


=head2 Sample format file

This format file generates vertical lists of tables and references rather than single paragraph, comma separated
lists (which is the default).

 {def:tablelist}
 List of Tables
  




1092




 





 





 





 





 





 



  NameDescription 




1093




 





 





 





 





 





 



  {tablelist} 




1094

 {tablelist}



 {/def:tablelist}

 {def:tablelistitem}
 {def:tablelistsep}\n{/def:tablelistsep}

 {def:refby}Referenced by: {refbylist}{/def:refby}
 {def:refbyitem}{fk}={tablename}.{key} {action}{/def:refbyitem}
 {def:refbysep} {/def:refbysep}

 {def:refto}References: {reftolist}{/def:refto}
 {def:reftoitem} {fk}={tablename}.{key} {action}{/def:reftoitem}
 {def:reftosep}{/def:reftosep}

 # Comments don't matter
 {def:permission}Permissions{permissionlist}{/def:permission}
 {def:permissionitem}{permission}{/def:permissionitem}
 {def:permissionsep}{/def:permissionsep}

Note that comments or other text outside the {def:}
The other template elements are the same as the default.


=head1 TODO

Things that might get added in future versions:

Views are not currently documented.

Bugs etc

=cut

__END__