Docbook::Table - create Docbook tables from Perl data structures

Docbook-Table documentation Contained in the Docbook-Table distribution.

Index

Code Index:

NAME

Top

Docbook::Table -- create Docbook tables from Perl data structures

SYNOPSIS

Top

    use Docbook::Table;
    my $t = Docbook::Table->new();
    $t->title("Pet names");
    $t->headings("Pet type", "Pet name");

    my %pets = (
        dog     => "Rover",
        cat     => "Garfield",
        bird    => "Tweetie"
    );

    $t->body(\%pets);
    $t->generate;

    $t->sort(\&backwards);

DESCRIPTION

Top

This module generates Docbook SGML/XML tables from Perl data structures. Its main purpose is to simplify automatic document generation.

Starting your table

    use Docbook::Table;
    my $t = Docbook::Table->new();

Specifying the title

Docbook tables must have a title. You can set the title by passing a string to the title() method.

    $t->title("This is the title");

Specifying the headings

Simply pass a list of headings to the headings() method.

    $t->headings(@headings);

Note that the number of columns (a required attribute of the tgroup element) is generated by counting the number of elements in the list passed to headings().

Specifying the body

Accepted data types for the body of the table are:

Simple hash

Used to generate a simple 2-column table.

List of lists

Used to generate multi-column tables.

Hash of lists

Used to generate multi-column tables.

Hash of hashes and other structures

Not supported (yet).

All data structures for the body should be passed by reference to the body() method.

    $t->body(\%hash);
    $t->body(\@list);

If you pass it the wrong sort of thing, it will emit a warning and return undef.

Sorting

By default, hashes are sorted asciibetically by key, and lists are left in their original order. If you wish to specify a different sort order, pass a subroutine reference to the sort() method.

    $t->sort(\&backwards);
    $t->sort( sub { $b cmp $a } );

If you pass it anything other than a subroutine reference, it will emit a warning and return undef.

Generating the table

The generate() method actually generates the table for you and returns it as a string. It will emit warnings and return undef if you haven't specified a title, headings and a body.

AUTHOR

Top

Kirrily Robert <skud@cpan.org>

COPYING

Top

Docbook::Table (c) 2001 Kirrily Robert <skud@cpan.org> This software is distributed under the same licenses as Perl itself.

SEE ALSO

Top

YAML

Docbook-Table documentation Contained in the Docbook-Table distribution. 
#!/usr/bin/perl -w


package Docbook::Table;

require v5.6.0;
use strict;
use warnings;
use Carp;

our $VERSION = '1.00';


sub new {
    my $self = {};
    $self->{calling_package} = (caller)[0];
    bless $self;
    return $self;
}


sub title {
    my ($self, $title) = @_;
    $self->{title} = $title;
}


sub headings {
    my ($self, @headings) = @_;
    unless (@headings) {
        carp "No headings specified";
        return undef;
    }
    $self->{headings} = \@headings;
}


sub body {
    my ($self, $bodyref) = @_;
    unless (ref $bodyref eq 'HASH' or ref $bodyref eq 'ARRAY') {
        carp "Body must be an arrayref or hashref";
        return undef;
    }
    $self->{body} = $bodyref;
}



sub sort {
    my ($self, $sortsub) = @_;
    unless (ref $sortsub eq 'CODE') {
        carp "Sort must be a subroutine reference";
        return undef;
    }
    $self->{sortsub} = $sortsub;
}


sub generate {
    my ($self) = @_;

    foreach (qw(title headings body)) {
        unless ($self->{$_}) {
            warn "No $_ specified\n";
            return undef;
        }
    }

    return $self->table_opening()
        . $self->table_head()
        . $self->table_body()
        . $self->table_close;
}


sub table_opening {
    my $self = shift;
    my $cols = @{$self->{headings}};

    return qq(<table>
<title>$self->{title}</title>
<tgroup cols="$cols">
);

}


sub table_head {
    my $self = shift;
    my @headings = @{$self->{headings}};

    my $out = qq(<thead>\n);
    $out .= $self->row(@headings);
    $out .= qq(</thead>\n);
}

sub table_body {
    my $self = shift;
    my $bodyref = $self->{body};

    my $out = "<tbody>\n";


    # note to self and others:
    # this is a little funky.  If we don't alias $a and $b across 
    # from the calling package, we can't sort properly.  A side 
    # effect of this is that we'll also end up with the calling 
    # package's @a, %a and &a (and b, too) so D::T has to be 
    # careful not to use them. 
    {
        no strict 'refs';
        *Docbook::Table::a = *{$self->{calling_package} . "::a"};
        *Docbook::Table::b = *{$self->{calling_package} . "::b"};
    }

    if (ref $bodyref eq 'HASH') {
        my $sort = $self->{sortsub} || sub { $a cmp $b };
        foreach my $key (sort $sort keys %$bodyref) {
            if (ref $bodyref->{$key} eq 'ARRAY') {
                $out .= $self->row($key, @{$bodyref->{key}});
            } elsif (ref $bodyref->{$key}) {
                carp "Unsupported data structure.  Looks like you've got something other than scalars or arrayrefs in the values of the hash you're using for the body.";
                return undef;
            } else {
                $out .= $self->row($key, $bodyref->{key});
            }
        }
    } elsif (ref $bodyref eq 'ARRAY') {
        my $sort = $self->{sortsub} || sub { 1 }; 
                    # sub { 1 } just leaves the list alone
        foreach my $row (sort $sort @$bodyref) {
            $out .= $self->row(@$row);
        }
    }

    $out .= "/<tbody>\n";

    return $out;

}


sub row {
    shift;
    my @entries = @_;
    my $row = "\t<row>\n";
    $row .= "\t\t<entry>$_</entry>\n" foreach @entries;
    $row .= "\t</row>\n";
    return $row;
}

sub table_close {
    return qq(</table>\n);
}

return "FALSE";     # true value ;)