#Copyright Massachusetts Institute of technology, 2002.
#Written by Eric Prud'hommeaux for the World Wide Web Consortium

use strict;

$W3C::Rdf::ResultSet::REVISION = '$Id: HTMLTableRenderer.pm,v 1.1 2004/07/17 14:55:05 eric Exp $ ';

package W3C::XML::HTMLTableRenderer;
use W3C::Util::Object;
use vars qw(@ISA);
@ISA = qw(W3C::Util::NamedParmObject);

use vars qw($DATUM $HEADER $LEFT $RIGHT);
($DATUM, $HEADER, $LEFT, $RIGHT) = (1..4);

sub new {
    my ($proto, @parms) = @_;
    my $self = $proto->SUPER::new(@parms);
    $self->{DATA} = [];		# [rows x columns] matrix of added data
    $self->{TYPES} = [];	# type (DATUM or HEADER) of each row
    $self->{WIDTHS} = [];	# widths of each cell in each row
    $self->{HEIGHTS} = [];	# heights of each row
    $self->{TABLE_WIDTH} = 0;	# widths of full-row cells
    $self->{UN_MARKED_PREFIX} = [];
    $self->{MARKED_PREFIX} = [];
    $self->{LINE_NO} = 0;

    if (exists $self->{-markRow}) {
	my $marker = exists $self->{-rowMarker} ? $self->{-rowMarker} : '->';
	$self->{UN_MARKED_PREFIX} = [' ' x length $marker];
	$self->{MARKED_PREFIX} = [$marker];
    }

    if ($self->{-firstTitle}) {
	$self->addHeaders($self->{-firstTitle});
    }

    $self->{-demarks} ||= ['|', '|', '|'];
    $self->{-rowDemarks} ||= ['|', '|', '|'];

    return $self;
}

sub addHeaders {
    my ($self, @data) = @_;
    $self->_addData(\@data, $HEADER, '-headerFilter', $HEADER, 0, $RIGHT);
}

sub addData {
    my ($self, @data) = @_;
    $self->_addData(\@data, $DATUM, '-dataFilter', $DATUM, 0, $RIGHT);
}

sub addRow {
    my ($self, @data) = @_;
    $self->_addData(\@data, $DATUM, '-dataFilter', $DATUM, 1, $LEFT);
}

sub underline {
    my ($self, $index) = @_;
    if (defined $index) {
	$self->{DATA}[-1][$index][1] = $HEADER;
    } else {
	foreach my $column (@{$self->{DATA}[-1]}) {
	    $column->[1] = $HEADER;
	}
    }
}

sub toString {
    my ($self) = @_;
    my @ret;

    push (@ret, "<table border=\"1\">\n  <tbody>");
    # Make sure the total column widths >= table width
    if ($self->{TABLE_WIDTH}) {
	my $totalWidth = -1;
	map {$totalWidth += $_+1} @{$self->{WIDTHS}};
	if ($totalWidth < $self->{TABLE_WIDTH}) {
	    $self->{WIDTHS}[-1] += $self->{TABLE_WIDTH} - $totalWidth;
	}
    }

#    push (@ret, $self->_hr);
    for (my $rowNo = 0; $rowNo < @{$self->{DATA}}; $rowNo++) {
	my $row = $self->{DATA}[$rowNo];
	push (@ret, '    <tr>'.join ("\n", $self->_renderRow($self->{DATA}[$rowNo], $self->{HEIGHTS}[$rowNo])).'</tr>');
    }
#    push (@ret, $self->_hr);
    push (@ret, "  </tbody>\n</table>");
    return join ("\n", @ret);
}

sub _addData {
    my ($self, $data, $type, $filterName, $mode, $fullSpan, $justify) = @_;
    if (ref $data->[0] eq 'ARRAY') {
	$data = [@{$data->[0]}];
    }
    if (@$data && ref $data->[0] ne 'ARRAY') {
	$data = [$data];
    }
    foreach my $row (@$data) {
	my $rowEntry = [];
	push (@{$self->{DATA}}, $rowEntry);
	push (@{$self->{TYPES}}, $DATUM);
	my $prefix = $self->{UN_MARKED_PREFIX};
	if ($mode == $DATUM) {
	    if ($self->{LINE_NO} == $self->{-markRow}) {
		$prefix = $self->{MARKED_PREFIX};
	    }
	    $self->{LINE_NO}++;
	}
	my $columnNo = 0;
	while ($columnNo < @$prefix) {
	    my $datum = $prefix->[$columnNo];
	    $self->_checkWidth($datum, @{$self->{DATA}} - 1, $columnNo, 0);
	    push (@$rowEntry, [$datum, $type, 0]);
	    $columnNo++;
	}
	while ($columnNo < @$prefix + @$row) {
	    # if ($columnNo == @{$self->{WIDTHS}}) {
	    # 	push (@{$self->{WIDTHS}}, 0);
	    # }
	    my $datum = $row->[$columnNo - @$prefix];
	    if (my $filter = $self->{$filterName}) {
		local $_ = $datum;
		&$filter;
		$datum = $_;
	    }
	    $self->_checkWidth($datum, @{$self->{DATA}} - 1, $columnNo, $fullSpan);
	    push (@$rowEntry, [$datum, $type, $fullSpan, $justify]);
	    $columnNo++;
	}
    }
    return scalar @$data;
}

sub _hr {
    my ($self) = @_;
    my @ret;
    foreach my $width (@{$self->{WIDTHS}}) {
	push (@ret, '-' x $width);
    }
    return join ('+', (undef, @ret, undef));
}

sub _checkWidth {
    my ($self, $datum, $rowNo, $column, $fullSpan) = @_;

    my @lines = split("\n", $datum);
    if (@lines) {
	foreach my $line (@lines) {
	    if ($fullSpan) {
		if (length ($line) > $self->{TABLE_WIDTH}) {
		    $self->{TABLE_WIDTH} = length ($line);
		}
	    } else {
		if ($column > @{$self->{WIDTHS}}-1 || length ($line) > $self->{WIDTHS}[$column]) {
		    $self->{WIDTHS}[$column] = length ($line);
		}
	    }
	}
    } elsif (defined $datum && $column > @{$self->{WIDTHS}}-1) {
	# Make sure that empty cells create a column that's zero width.
	$self->{WIDTHS}[$column] = 0;
    }
    if (@lines > $self->{HEIGHTS}[$rowNo]) {
	$self->{HEIGHTS}[$rowNo] = @lines;
    }
}

sub _renderRow {
    my ($self, $row, $height) = @_;
    my $footer = [];
    my $rows = [];
    my $needsFooter = 0;
    my ($left, $mid, $right) = @{$self->{-demarks}};
    for (my $column = 0; $column < @{$self->{WIDTHS}}; $column++) {
	my ($datum, $type, $fullSpan, $justify) = @$row > $column ? @{$row->[$column]} : (undef, undef, 0);
	my $width = 0;
	if ($fullSpan) {
	    map {$width += $_+1} @{$self->{WIDTHS}};
	    $width--; # handle the last line delimeter.
	} else {
	    $width = $self->{WIDTHS}[$column];
	}
	my @lines = split("\n", $datum);
	my $lineNo = 0;
	my $tag = $type == $HEADER ? 'th' : 'td';
	while ($lineNo < @lines) {
	    my $line = &_escape($lines[$lineNo]);
	    my $pad = ' ' x ($width - length ($line));
	    $rows->[$lineNo][$column] = $justify == $LEFT ? "<$tag>$line</$tag>$pad" : "$pad<$tag>$line</$tag>";
	    $lineNo++;
	}
	while ($lineNo < $height) {
	    $rows->[$lineNo][$column] = ' ' x $width;
	    $lineNo++;
	}
	#if ($type == $HEADER) {
	#    push (@$footer, '-' x $width);
	#    $needsFooter++;
	#} else {
	#    push (@$footer, ' ' x $width); # might need one on another column
	#}
	if ($fullSpan) {
	    ($left, $mid, $right) = @{$self->{-rowDemarks}};
	    last;
	}
    }
    if ($needsFooter) {
	push (@$rows, [@$footer]);
    }
    return map {join ('', @$_)} @$rows;
    my @ret = map {$left.(join ($mid, @$_)).$right} @$rows;
    return @ret;
}
use CGI;
sub _escape {
    $_ = $_[0];
    s/\&/&amp;/g;
    s/\</&lt;/g;
    s/\>/&gt;/g;
    $_;
}

1;

__END__

=head1 NAME

W3C::XML::HTMLTableRenderer - spit out data in an XHTML table

=head1 SYNOPSIS

 use W3C::XML::HTMLTableRenderer;
 my @a = ([1, 'a'], [2, 'b']);
 my $renderer = new W3C::XML::HTMLTableRenderer;
 $renderer->addHeaders("int", "char");
 $renderer->addData(\@a);
 print $renderer->toString,"\n";

=head1 DESCRIPTION

Display tabular data in a space-extended ascii table.

=head1 METHODS

=over 4

=item new

Create a new HTMLTableRenderer. Takes arguments in hash or array form.

=over 4

=item -dataFilter

Specify code to call to manipute the data. This code should alter C<$_> to appear as it should in the serialized ascii table.

=item -headerFilter

Specify code to call to manipute the header labels. This code should alter C<$_> to appear as it should in the serialized ascii table.

=item -markRow

Indicate a row to mark with the C<row marker>.

=item -rowMarker

A string to indicate the b<current row> as defined by C<markRow>.

=back

=item addHeader

Add headers to the current HTMLTableRenderer data set. This is customarily done at the beginning, however, headers may be added anywhere in the data. Headers added after data will, in fact, appear after that data.

The headers may be passed in as a list, an array ref, or an array of arrays. The following are all equivilent:

=over 4

        $renderer->addHeaders('letters', 'numbers');
        $renderer->addHeaders(['letters', 'numbers']);
        $renderer->addHeaders([['letters', 'numbers']]);
        $renderer->addData('letters', 'numbers'); $self->underline();

=back

See L<FORMATTING> for affects of linefeeds in the data.

=item addData

Add data to the current HTMLTableRenderer data set. The data may be passed in as a list, an array ref, or an array of arrays (see L<"addHeader">). See L<FORMATTING> for affects of linefeeds in the data.

=item underline ([$index])

Underline (highlight) the last row of data. If a numeric C<$index> is provided, underline only that column.

=item toString

Serialize the added headers and data in an ascii table.

=back

=head1 FORMATTING

Cell entries may have line feeds C<"\n"> embedded in them. In this case, the data is rendered on multiple lines, but the tabular format is preserved.

Row data may have more columns than previous headers and data. This will have no affect accept that subsequent calls to L<underline> will underline the extra column.

=head1 EXAMPLES

=over 4

    use W3C::XML::HTMLTableRenderer;

    # Any data starting with "trimMe" will have that part removed.
    my $renderer = new W3C::XML::HTMLTableRenderer(-dataFilter => sub {s/^trimMe//});

    # Add two two-line headers
    $renderer->addHeaders("my\nletter", "your\nnumber");

    # Add a row of data that's just crying out to be filtered.
    $renderer->addData([qw(trimMea trimMe1)]);

    # Underline that last row.
    $renderer->underline();

    # Add another row, this time with an unexpected extra column ...
    $renderer->addData(['trimMeb', 'trimMe2', "extra\ncolumn"]);
    # ... and underline it.
    $renderer->underline();

    # Add a two dimensional matrix of data.
    $renderer->addData([[qw(c 3)], [qw(d 4)]]);

    # Underline just column 1 of the previous row.
    $renderer->underline(1);

    # Let's see what hath we wrought.
    print $renderer->toString,"\n";

=back

The above should produce this output:

=over 4

    +------+------+------+
    |    my|  your|      |
    |letter|number|      |
    |------|------|      |
    |     a|     1|      |
    |------|------|      |
    |     b|     2| extra|
    |      |      |column|
    |------|------|------|
    |     c|     3|      |
    |     d|     4|      |
    |      |------|      |
    +------+------+------+

=back

=head1 AUTHOR

Eric Prud\'hommeaux <eric@w3.org>

=head1 SEE ALSO

perl(1).

=cut
