package Base::HTML::Elements;
use strict;
use warnings;
use base 'Exporter';
our @EXPORT_OK = qw(table cols col row cell list);
use Base::Nifty qw(line);
sub get_attributes {
my ($options, $valid) = @_;
my @attributes;
for (@{$valid}) {
my $value = $options->{$_};
push @attributes, qq($_="$value") if $options->{$_};
}
return join(' ',('',@attributes));
}
sub list {
my ($tab,$type,$list,$opt) = @_;
my $attributes = get_attributes($opt,['id','class','style']);
my $tag = $type.'l';
my $open = $tag.$attributes;
line($tab,qq(<$open>));
line($tab + 1,qq(
$_)) for @$list;
line($tab,qq($tag>));
}
sub cell {
my ($tab,$type,$contents,$opt) = @_;
my $attributes = get_attributes($opt,['id','class','style','colspan','rowspan']);
my $tag = 't'.$type;
my $open = $tag.$attributes;
line($tab,qq(<$open>));
if ($contents =~ /list/i) {
list($tab + 1,@{$opt->{list}});
}
else {
line($tab + 1,$contents);
}
line($tab,qq($tag>));
}
sub row {
my ($tab,$type,$cells,$opt) = @_;
my %types = (
header => 'h',
data => 'd',
whead => 'd'
);
my $attributes = get_attributes($opt,['id','class','style']);
my $open = 'tr'.$attributes;
line($tab,qq(<$open>));
if ($type eq 'whead') {
my $cell = shift @{$cells};
cell($tab + 1,'h',ucfirst $cell, { class => 'row_header' });
}
my $cell_type = $types{$type};
for my $cell (@{$cells}) {
if (ref($cell) eq 'ARRAY') {
cell($tab + 1,$cell_type,$cell->[0],$cell->[1]);
}
else {
cell($tab + 1,$cell_type,$cell);
}
}
line($tab,q());
}
sub col {
my ($tab,$opt) = @_;
my $attributes = get_attributes($opt,['id','class','span']);
my $open = 'col'.$attributes;
line($tab,qq(<$open>));
}
sub cols {
my ($tab,$cols) = @_;
col($tab,$_) for @{$cols};
}
sub table {
my ($tab,$opt) = @_;
my $attributes = get_attributes($opt,['id','class','style']);
my $open = 'table'.$attributes;
line($tab,qq(<$open>));
line($tab + 1,qq($opt->{caption})) if $opt->{caption};
row($tab + 1,'header',$opt->{headings}) if $opt->{headings};
if ($opt->{data}) {
row($tab + 1,'data',$_) for @{$opt->{data}};
}
if ($opt->{whead}) {
row($tab + 1,'whead',$_) for @{$opt->{whead}};
}
line($tab,q());
}
1;
####
sub get_attributes {
my ($options, $valid) = @_;
my @attributes;
for (@{$valid}) {
my $value = $options->{$_};
push @attributes, qq($_="$value") if $options->{$_};
}
return [@attributes];
}