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(<li>$_</li>)) 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(</tr>));
}

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(<caption>$opt->{caption}</caption>)) if $opt->{capt
+ion};

  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(</table>));
}

1;
[download]

sub get_attributes {
  my ($options, $valid) = @_;
  my @attributes;
  for (@{$valid}) {
    my $value = $options->{$_};
    push @attributes, qq($_="$value") if $options->{$_};
  }
  return [@attributes];
}
[download]