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