HTML-Widgets-Table-0.01/ 0040755 0000764 0000764 00000000000 07731016050 012764 5 ustar don don HTML-Widgets-Table-0.01/Table/ 0040755 0000764 0000764 00000000000 07731016050 014013 5 ustar don don HTML-Widgets-Table-0.01/Table/Row.pm 0100644 0000764 0000764 00000005301 07731015157 015123 0 ustar don don # -*-perl-*-
# Creation date: 2003-09-06 13:10:07
# Authors: Don
# Change log:
# $Id: Row.pm,v 1.6 2003/09/14 07:36:15 don Exp $
#
# Copyright (c) 2003 Don Owens
#
# All rights reserved. This program is free software; you can
# redistribute it and/or modify it under the same terms as Perl
# itself.
use strict;
use HTML::Widgets::Table::Core;
use HTML::Widgets::Table::Cell;
{ package HTML::Widgets::Table::Row;
use vars qw($VERSION);
$VERSION = do { my @r=(q$Revision: 1.6 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
use base 'HTML::Widgets::Table::Core';
sub new {
my ($proto, $params) = @_;
$params = {} unless ref($params) eq 'HASH';
my $self = bless { _params => $params, _cells => [] }, ref($proto) || $proto;
return $self;
}
sub isHeaderRow {
return shift()->_getParams()->{header};
}
sub _getNonAttrParams {
return { header => 1,
};
}
sub addCell {
my ($self, $data, $params) = @_;
if (UNIVERSAL::isa($data, 'HTML::Widgets::Table::Cell')) {
push @{$$self{_cells}}, $data;
return 1;
}
$params = {} unless ref($params) eq 'HASH';
my $row_params = $self->_getParams;
my $new_params = $params;
$new_params = { %$params, header => $$row_params{header} } if $$row_params{header};
my $cell = $self->getNewCellObj($data, $new_params);
push @{$$self{_cells}}, $cell;
return 1;
}
sub getNewCellObj {
my ($self, $data, $params) = @_;
return HTML::Widgets::Table::Cell->new($data, $params);
}
sub render {
my ($self, $render_params, $overridable_params) = @_;
$render_params = {} unless ref($render_params) eq 'HASH';
$overridable_params = {} unless ref($overridable_params) eq 'HASH';
my $render_attr = $self->_getRenderAttr;
foreach my $key (keys %$render_params) {
$$render_attr{$key} = $$render_params{$key};
}
foreach my $key (keys %$overridable_params) {
$$render_attr{$key} = $$overridable_params{$key} unless exists $$render_attr{$key};
}
my $attr_str = $self->_getAttributeStringFromHash($render_attr);
$attr_str = ' ' . $attr_str unless $attr_str eq '';
my $str;
$str .= "\n";
$str .= join("\n", map { $_->render } @{$$self{_cells}} ) . "\n";
$str .= "\n";
return $str;
}
}
1;
__END__
=pod
=head1 NAME
HTML::Widgets::Table::Row -
=head1 SYNOPSIS
=head1 DESCRIPTION
=head1 METHODS
=head1 EXAMPLES
=head1 BUGS
=head1 AUTHOR
=head1 VERSION
$Id: Row.pm,v 1.6 2003/09/14 07:36:15 don Exp $
=cut
HTML-Widgets-Table-0.01/Table/Core.pm 0100644 0000764 0000764 00000003404 07731015157 015246 0 ustar don don # -*-perl-*-
# Creation date: 2003-09-08 08:10:51
# Authors: Don
# Change log:
# $Id: Core.pm,v 1.2 2003/09/14 07:36:15 don Exp $
#
# Copyright (c) 2003 Don Owens
#
# All rights reserved. This program is free software; you can
# redistribute it and/or modify it under the same terms as Perl
# itself.
use strict;
{ package HTML::Widgets::Table::Core;
use vars qw($VERSION);
$VERSION = do { my @r=(q$Revision: 1.2 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
sub new {
my ($proto) = @_;
my $self = bless {}, ref($proto) || $proto;
return $self;
}
sub _getAttributeStringFromHash {
my ($self, $hash) = @_;
my @pairs;
foreach my $key (sort keys %$hash) {
my $val = $$hash{$key};
push @pairs, qq{$key="$val"};
}
return join(" ", @pairs);
}
sub _getParams {
return shift()->{_params} || {};
}
# add in defaults
sub _getRenderAttr {
my ($self) = @_;
my $params = $self->_getParams;
my $defaults = $self->can('_getDefaultParams') ? $self->_getDefaultParams : {};
my $non_attr = $self->can('_getNonAttrParams') ? $self->_getNonAttrParams : {};
my $render_params = {};
foreach my $key (keys %$params) {
$$render_params{$key} = $$params{$key} unless exists $$non_attr{$key};
}
foreach my $key (keys %$defaults) {
$$render_params{$key} = $$defaults{$key} unless exists($$params{$key});
}
return $render_params;
}
}
1;
__END__
=pod
=head1 NAME
HTML::Widgets::Table::Core -
=head1 SYNOPSIS
=head1 DESCRIPTION
=head1 METHODS
=head1 EXAMPLES
=head1 BUGS
=head1 AUTHOR
=head1 VERSION
$Id: Core.pm,v 1.2 2003/09/14 07:36:15 don Exp $
=cut
HTML-Widgets-Table-0.01/Table/Cell.pm 0100644 0000764 0000764 00000003577 07731015157 015250 0 ustar don don # -*-perl-*-
# Creation date: 2003-09-06 13:30:01
# Authors: Don
# Change log:
# $Id: Cell.pm,v 1.4 2003/09/14 07:36:15 don Exp $
#
# Copyright (c) 2003 Don Owens
#
# All rights reserved. This program is free software; you can
# redistribute it and/or modify it under the same terms as Perl
# itself.
use strict;
use HTML::Widgets::Table::Core;
{ package HTML::Widgets::Table::Cell;
use vars qw($VERSION);
$VERSION = do { my @r=(q$Revision: 1.4 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
use base 'HTML::Widgets::Table::Core';
sub new {
my ($proto, $data, $params) = @_;
$params = {} unless ref($params) eq 'HASH';
my $self = bless { _data => $data, _params => $params }, ref($proto) || $proto;
return $self;
}
sub render {
my ($self) = @_;
my $params = $$self{_params};
my $attr = $self->_getRenderAttr;
if ($$params{pretty_border_background} ne '') {
$$attr{bgcolor} = $$params{pretty_border_background} unless exists $$attr{bgcolor};
}
my $str;
my $data = $$self{_data};
if (ref($data) eq 'HASH') {
my $hash = $data;
$data = $$hash{data};
if (ref($$hash{attr}) eq 'HASH') {
$attr = { %$attr, %{$$hash{attr}} };
}
}
my $attr_str = $self->_getAttributeStringFromHash($attr);
$attr_str = ' ' . $attr_str unless $attr_str eq '';
my $tag_name = $$params{header} ? 'th' : 'td';
return qq{<$tag_name$attr_str>$data};
}
sub _getNonAttrParams {
return { pretty_border_background => 1, header => 1 };
}
}
1;
__END__
=pod
=head1 NAME
HTML::Widgets::Table::Cell -
=head1 SYNOPSIS
=head1 DESCRIPTION
=head1 METHODS
=head1 EXAMPLES
=head1 BUGS
=head1 AUTHOR
=head1 VERSION
$Id: Cell.pm,v 1.4 2003/09/14 07:36:15 don Exp $
=cut
HTML-Widgets-Table-0.01/Table.pm 0100644 0000764 0000764 00000022664 07731015663 014371 0 ustar don don # -*-perl-*-
# Creation date: 2003-09-05 20:58:07
# Authors: Don
# Change log:
# $Id: Table.pm,v 1.7 2003/09/14 07:41:39 don Exp $
#
# Copyright (c) 2003 Don Owens
#
# All rights reserved. This program is free software; you can
# redistribute it and/or modify it under the same terms as Perl
# itself.
use strict;
use HTML::Widgets::Table::Core;
use HTML::Widgets::Table::Row;
=pod
=head1 NAME
HTML::Widgets::Table - An HTML table generation class.
=head1 SYNOPSIS
use HTML::Widgets::Table;
my $table = HTML::Widgets::Table->new(\%params);
my $html = $table->render;
=head1 DESCRIPTION
HTML::Widgets::Table creates an HTML table from native data structures.
=head1 METHODS
=cut
{ package HTML::Widgets::Table;
use vars qw($VERSION);
BEGIN {
$VERSION = '0.01'; # change in POD below
};
use base 'HTML::Widgets::Table::Core';
=pod
=head2 new(\%params)
Create a new table object. Parameters that can be passed
include any legal attributes for an HTML table tag. In
addition, the following parameters may be passed.
=over 4
pretty_border => 1
pretty_border_color => '#669999'
If pretty_border is a true value, the table will be rendered
with a browser-independent border by putting the table inside
another table, allowing the background color of the outside
table come through as the border. The value of pretty_border
will be with width of the border, and pretty_border_color
will be the color of the border.
alternating_row_colors => [ '#ffffff',
'#f2f2f2'
]
You can use this to alternate the background color of the
rows in the table. This is useful for making tables without
borders and rules easier to read.
=back
=cut
sub new {
my ($proto, $params) = @_;
$params = {} unless ref($params) eq 'HASH';
my $self = { _rows => [], _indent_level => 0, _indent_width => 0,
_params => $params };
bless $self, ref($proto) || $proto;
return $self;
}
=pod
=head2 addHeaderRow(\@data, \%cell_params, \%params)
Adds a header row to the table (as in the tags for the
columns). Header rows are also enclosed in tags. @data
is an array of column values. Any elements of the array that
are hash references are taken to be key/value pairs with the
cell contents as the value associated with the key 'data', and
all the other key/value pairs are attributes to be applied to
that cell. These override the values in %cell_params.
%cell_params are default attributes for every column in the row.
%params are the row attributes to go in the tag.
=cut
sub addHeaderRow {
my ($self, $data, $cell_params, $params) = @_;
$params = {} unless ref($params) eq 'HASH';
$params = { %$params, header => 1};
return $self->_addRow($data, $cell_params, $params);
}
=pod
=head2 addRow(\@data, \%cell_params, \%params)
Adds a new row to the table. @data is an array of column
values. Any elements of the array that are hash references are
taken to be key/value pairs with the cell contents as the value
associated with the key 'data', and all the other key/value
pairs are attributes to be applied to that cell. These override
the values in %cell_params. %cell_params are default attributes
for every column in the row. %params are the row attributes to
go in the tag.
=cut
sub addRow {
my ($self, $data, $cell_params, $params) = @_;
return $self->_addRow($data, $cell_params, $params);
}
=pod
=head2 setRepeatingHeaderRow(\@data, \%cell_params, \%params, $repeat_interval)
Adds a header row to be repeated every $repeat_interval rows.
This is useful to keep the user oriented when viewing long tables.
=cut
sub setRepeatingHeaderRow {
my ($self, $data, $cell_params, $params, $repeat_interval) = @_;
$params = {} unless ref($params) eq 'HASH';
$params = { %$params, header => 1};
my $row = $self->_createRow($data, $cell_params, $params);
$$self{_repeating_header_row} = $row;
$$self{_repeating_header_row_interval} = $repeat_interval;
return 1;
}
=pod
=head2 setRepeatingRow(\@data, \%cell_params, \%params, $repeat_interval)
Adds a row to be repeated every $repeat_interval rows.
This is useful to keep the user oriented when viewing long tables.
=cut
sub setRepeatingRow {
my ($self, $data, $cell_params, $params, $repeat_interval) = @_;
my $row = $self->_createRow($data, $cell_params, $params);
$$self{_repeating_header_row} = $row;
$$self{_repeating_header_row_interval} = $repeat_interval;
return 1;
}
sub _addRow {
my ($self, $data, $cell_params, $params) = @_;
my $row = $self->_createRow($data, $cell_params, $params);
push @{$$self{_rows}}, $row;
return 1;
}
sub _createRow {
my ($self, $data, $cell_params, $params) = @_;
if (UNIVERSAL::isa($data, 'HTML::Widgets::Table::Row')) {
push @{$$self{_rows}}, $data;
return 1;
}
$params = {} unless ref($params) eq 'HASH';
$params = { %$params };
my $row = $self->getNewRowObj($params);
$cell_params = {} unless ref($cell_params) eq 'HASH';
$cell_params = { %$cell_params }; # make copy
my $table_params = $self->_getParams;
if ($$table_params{pretty_border}) {
my $bg_color = $$table_params{pretty_border_background};
$bg_color = '#ffffff' if $bg_color eq '';
$cell_params = { pretty_border_background => $bg_color, %$cell_params };
}
foreach my $cell (@$data) {
$row->addCell($cell, $cell_params);
}
return $row;
}
sub _addRowObj {
my ($self, $row) = @_;
push @{$$self{_rows}}, $row;
}
sub getNewRowObj {
my ($self, $params) = @_;
return HTML::Widgets::Table::Row->new($params);
}
sub _getDefaultParams {
my ($self) = @_;
my $defaults = { summary => '', border => 0 };
return $defaults;
}
sub _getNonAttrParams {
return { pretty_border => 1,
pretty_border_color => 1,
pretty_border_background => 1,
alternating_row_colors => 1,
};
}
=pod
=head2 render()
Returns a string containing the HTML version of the table.
=cut
sub render {
my ($self) = @_;
my $str;
my $params = $self->_getParams;
my $attr = $self->_getRenderAttr;
my $repeat_row = $$self{_repeating_header_row};
my $repeat_interval = $$self{_repeating_header_row_interval};
$repeat_row = undef unless $repeat_interval > 1;
my $alternating_row_colors = $$params{alternating_row_colors};
$alternating_row_colors = undef unless ref($alternating_row_colors) eq 'ARRAY'
and @$alternating_row_colors;
if (my $width = $$params{pretty_border}) {
$$attr{cellspacing} = $width;
$$attr{width} = '100%';
}
my $attr_str = $self->_getAttributeStringFromHash($attr);
$attr_str = ' ' . $attr_str unless $attr_str eq '';
$str .= qq{\n};
my $head = 0;
my $body = 0;
my $body_row_count = -1;
my $row_num = -1;
foreach my $row (@{$$self{_rows}}) {
$row_num++;
my $this_row_params = {};
if ($repeat_row and $row_num % $repeat_interval == 0) {
$str .= $repeat_row->render;
}
if ($row->isHeaderRow) {
if (defined($head)) {
if ($head == 0) {
$str .= qq{\n};
}
$head++;
}
} else {
if (defined($head) and $head != 0) {
$str .= qq{\n};
}
undef $head;
$str .= qq{\n} if $body == 0;
$body++;
}
if ($body) {
$body_row_count++;
if ($alternating_row_colors) {
my $num_colors = scalar(@$alternating_row_colors);
my $color = $$alternating_row_colors[$body_row_count % $num_colors];
$$this_row_params{bgcolor} = $color;
}
}
$str .= $row->render($this_row_params);
}
$str .= qq{ \n} if defined($head);
$str .= qq{\n} unless $body == 0;
$str .= qq{\n};
if (my $width = $$params{pretty_border}) {
my $border_color = $$params{pretty_border_color};
$border_color = '#000000' if $border_color eq '';
my $outer_table = $self->new({ bgcolor => $border_color, cellpadding => 0,
cellspacing => 0 });
my $cell_data = { data => "\n" . $str, attr => { bgcolor => $border_color } };
$outer_table->addRow([ $cell_data ], {}, { bgcolor => $border_color });
return $outer_table->render;
}
return $str;
}
}
1;
__END__
=pod
=head1 AUTHOR
Don Owens
=head1 COPYRIGHT
Copyright (c) 2003 Don Owens
All rights reserved. This program is free software; you can
redistribute it and/or modify it under the same terms as Perl
itself.
=head1 VERSION
0.01
=cut
HTML-Widgets-Table-0.01/t/ 0040755 0000764 0000764 00000000000 07731016050 013227 5 ustar don don HTML-Widgets-Table-0.01/t/00use.t 0100755 0000764 0000764 00000000645 07727106221 014362 0 ustar don don #!/usr/bin/perl
# Creation date: 2003-09-07 22:49:49
# Authors: Don
# Change log:
# $Id: 00use.t,v 1.1 2003/09/08 14:05:05 don Exp $
use strict;
use Carp;
# main
{
local($SIG{__DIE__}) = sub { &Carp::cluck(); exit 0 };
use Test;
BEGIN { plan tests => 1 }
use HTML::Widgets::Table; ok(1);
}
exit 0;
###############################################################################
# Subroutines
HTML-Widgets-Table-0.01/MANIFEST 0100644 0000764 0000764 00000000130 07727116010 014106 0 ustar don don README
MANIFEST
Makefile.PL
Table.pm
Table/Row.pm
Table/Cell.pm
Table/Core.pm
t/00use.t
HTML-Widgets-Table-0.01/README 0100644 0000764 0000764 00000006223 07731016033 013645 0 ustar don don NAME
HTML::Widgets::Table - An HTML table generation class.
SYNOPSIS
use HTML::Widgets::Table;
my $table = HTML::Widgets::Table->new(\%params);
my $html = $table->render;
DESCRIPTION
HTML::Widgets::Table creates an HTML table from native data structures.
METHODS
new(\%params)
Create a new table object. Parameters that can be passed
include any legal attributes for an HTML table tag. In
addition, the following parameters may be passed.
pretty_border => 1
pretty_border_color => '#669999'
If pretty_border is a true value, the table will be rendered
with a browser-independent border by putting the table inside
another table, allowing the background color of the outside
table come through as the border. The value of pretty_border
will be with width of the border, and pretty_border_color
will be the color of the border.
alternating_row_colors => [ '#ffffff',
'#f2f2f2'
]
You can use this to alternate the background color of the
rows in the table. This is useful for making tables without
borders and rules easier to read.
addHeaderRow(\@data, \%cell_params, \%params)
Adds a header row to the table (as in the tags for the
columns). Header rows are also enclosed in tags. @data
is an array of column values. Any elements of the array that
are hash references are taken to be key/value pairs with the
cell contents as the value associated with the key 'data', and
all the other key/value pairs are attributes to be applied to
that cell. These override the values in %cell_params.
%cell_params are default attributes for every column in the row.
%params are the row attributes to go in the tag.
addRow(\@data, \%cell_params, \%params)
Adds a new row to the table. @data is an array of column
values. Any elements of the array that are hash references are
taken to be key/value pairs with the cell contents as the value
associated with the key 'data', and all the other key/value
pairs are attributes to be applied to that cell. These override
the values in %cell_params. %cell_params are default attributes
for every column in the row. %params are the row attributes to
go in the tag.
setRepeatingHeaderRow(\@data, \%cell_params, \%params, $repeat_interval)
Adds a header row to be repeated every $repeat_interval rows.
This is useful to keep the user oriented when viewing long tables.
setRepeatingRow(\@data, \%cell_params, \%params, $repeat_interval)
Adds a row to be repeated every $repeat_interval rows.
This is useful to keep the user oriented when viewing long tables.
render()
Returns a string containing the HTML version of the table.
AUTHOR
Don Owens
COPYRIGHT
Copyright (c) 2003 Don Owens
All rights reserved. This program is free software; you can
redistribute it and/or modify it under the same terms as Perl
itself.
VERSION
0.01
HTML-Widgets-Table-0.01/Makefile.PL 0100755 0000764 0000764 00000002144 07727527177 014765 0 ustar don don #!/usr/bin/perl
# Creation date: 2003-09-06 12:51:45
# Authors: Don
# Change log:
# $Id: Makefile.PL,v 1.3 2003/09/10 04:54:23 don Exp $
use strict;
use Carp;
# main
{
local($SIG{__DIE__}) = sub { &Carp::cluck(); exit 0 };
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'HTML::Widgets::Table',
DISTNAME => 'HTML-Widgets-Table',
VERSION_FROM => 'Table.pm',
ABSTRACT => 'HTML Table Class',
AUTHOR => 'DON OWENS ',
PM => { 'Table.pm' => '$(INST_LIBDIR)/Table.pm',
'Table/Row.pm' => '$(INST_LIBDIR)/Table/Row.pm',
'Table/Cell.pm' => '$(INST_LIBDIR)/Table/Cell.pm',
'Table/Core.pm' => '$(INST_LIBDIR)/Table/Core.pm',
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz' },
DIR => [],
EXE_FILES => [],
);
}
exit 0;
###############################################################################
# Subroutines
| |