package HTML::Element;
use strict;
use warnings;
use base 'Exporter';
our @EXPORT_OK = qw(title script heading anchor paragraph sparagraph list definition_list table form fieldset legend label selection input textarea div pre);

use HTML::Entities qw(encode_entities);

use Base::Data qw(data_file get_hash);
use Base::Nifty qw(sline line);

my @ics = ('id','class','style');
my @java = qw(onclick ondblclick onkeypress onkeydown onkeyup onmouseover onmousedown onmouseup onmousemove onmouseout);

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

sub open_tag {
  my ($tag,$opt,$attributes) = @_;
  my $tag_attributes = get_attributes($opt,$attributes);

  return $tag.$tag_attributes;
}

sub plain_element {
  my ($tag,$attributes,$tab,$value,$opt) = @_;
  my $open = open_tag($tag,$opt,$attributes);
  
  return sline($tab,"<$open>$value</$tag>");
}

# Start elements

sub anchor {
  my ($value,$opt) = @_;
  my $tag = 'a';
  my $open = open_tag($tag,$opt,['href','target','title',@ics,@java]);

  return "<$open>$value</$tag>";
}

sub title {
  my ($tab,$value,$opt) = @_;
  my $tag = 'title';
  my $open = $tag;

  line($tab,"<$open>$value</$tag>");
}

sub script {
  my ($tab,$opt) = @_;
  my $tag = 'script';
  my $open = open_tag($tag,$opt,['type','src']);

  line($tab,"<$open></$tag>");

}
sub heading {
  my ($tab,$level,$value,$opt) = @_;
  my $tag = 'h'.$level;
  print plain_element($tag,[@ics,@java],$tab,$value,$opt);
}

# Begin paragraphs

sub sparagraph {
  my ($tab,$value,$opt) = @_;
  my $tag = 'p';
  my $open = open_tag($tag,$opt,[@ics,@java]);
  
  my $sep = $opt->{separator} ? $opt->{separator} : "\n";

  my $line;
  for (grep(length,split(/$sep/,$value))) {
    $line .= sline($tab,qq(<$open>));
    $line .= sline($tab + 1,$_);
    $line .= sline($tab,qq(</$tag>));
  }
  
  return $line;
}

sub paragraph {
  print sparagraph(@_);
}

# End paragraphs

# Begin elements for ordered and unordered lists.

sub item {
  my ($tab,$value,$opt) = @_;
  my $tag = 'li';
  my $open = open_tag($tag,$opt,[@ics,@java]);

  line($tab,qq(<$open>));

  line($tab + 1,$value);
  if ($opt->{inlist}) {
    list($tab + 1, @{$opt->{inlist}});
  }

  line($tab,qq(</$tag>));
}

sub list {
  my ($tab,$type,$list,$opt) = @_;
  my $tag = $type.'l';
  my $open = open_tag($tag,$opt,[@ics,@java]);


  line($tab,qq(<$open>));
  for my $item (@$list) {
    if (ref($item) eq 'ARRAY') {
      item($tab + 1,$item->[0],$item->[1]);
    }
    else {
      item($tab + 1,$item);
    }
  }

  line($tab,qq(</$tag>));
}

# End elements for ordered and unordered lists.

# Begin elements for definition lists.

sub term {
  print plain_element('dt',[@ics,@java],@_);
}

sub definition {
  my ($tab,$value,$opt) = @_;
  my $tag = 'dd';
  my $open = open_tag($tag,$opt,[@ics,@java]);

  line($tab,qq(<$open>));
  line($tab + 1,$value);
  line($tab,qq(</$tag>));
}

# I will be rewriting definition_list to get rid of the data gathering within it.

sub definition_list {
  my ($tab,$opt) = @_;
  my $tag = 'dl';
  my $open = open_tag($tag,$opt,[@ics,@java]);

  my %definition_list = get_hash(
    file => $opt->{file} ? $opt->{file} : data_file,
    headings => [@{$opt->{headings}}],
    sorted => 'yes',
  );

  line($tab,qq(<$open>));
  my $term = shift @{$opt->{headings}};
  for my $term (sort {$definition_list{$a}{sort_number} <=> $definition_list{$b}{sort_number}} keys %definition_list) {
    term($tab + 1,$term);
    if (@{$opt->{headings}} == 1) {
      definition($tab + 2,$definition_list{$term}{$opt->{headings}->[0]});
    }
    else {
      for my $heading (@{$opt->{headings}}) {
        my $upheading = ucfirst $heading;
        definition($tab + 2,qq(<b>$upheading:</b> ).encode_entities($definition_list{$term}{$heading}));
      }
    }
  }
  line($tab,qq(</$tag>));
}

# End elements for definition lists.

# Begin elemeents for tables.

sub caption {
  print plain_element('caption',['align',@ics,@java],@_);
}

sub cell {
  my ($tab,$type,$value,$opt) = @_;
  $type = $opt->{type_override} ? $opt->{type_override} : $type;
  my $tag = 't'.$type;
  my $open = open_tag($tag,$opt,['colspan','rowspan',@ics,@java]);
  
  line($tab,qq(<$open>));
  
  if ($value eq 'list') {
    list($tab + 1,@{$opt->{list}});
  }
  else {
    line($tab + 1,$value);
  }

  line($tab,qq(</$tag>));
}

sub row {
  my ($tab,$type,$cells,$opt) = @_;
  my $tag = 'tr';
  my $open = open_tag($tag,$opt,[@ics,@java]);

  my %types = (
    header => 'h',
    data   => 'd',
    whead  => 'd'
  );

  line($tab,qq(<$open>));

  if ($type eq 'whead') {
    my $cell = shift @{$cells};
    if (ref($cell) eq 'ARRAY') {
      cell($tab + 1,'h',ucfirst $cell->[0], { class => 'row_header', $cell->[1] });
    }
    else {
      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,qq(</$tag>));
}

sub col {
  my ($tab,$opt) = @_;
  my $tag = 'col';
  my $open = open_tag($tag,$opt,['span',@ics,@java]);

  line($tab,qq(<$open>));
}

sub cols {
  my ($tab,$cols) = @_;
  col($tab,$_) for @{$cols};
}

sub table {
  my ($tab,$opt) = @_;
  my $tag = 'table';
  my $open = open_tag($tag,$opt,[@ics,@java]);

  line($tab,qq(<$open>));

  if ($opt->{caption}) {
    if (ref($opt->{caption}) eq 'ARRAY') {
      caption($tab + 1, $opt->{caption}->[0],$opt->{caption}->[1]);
    }
    else {
      caption($tab + 1, $opt->{caption});
    }
  }

  if ($opt->{cols}) {
    col($tab + 1, $_) for @{$opt->{cols}};
  }

  for my $rowgroup (@{$opt->{rows}}) {
    my $type = $rowgroup->[0];
    my @rows = $rowgroup->[1];
    my $attributes = $rowgroup->[2];
    
    if ($type eq 'header') {
      row($tab + 1, $type , @rows, $attributes);
    }
    else {
      for my $row (@rows) {
        row($tab + 1, $type , $_, $attributes) for @$row;
      }
    }
  }

  line($tab,qq(</$tag>));
}

# End elements for tables.

# Start elements for forms.

sub label {
  print plain_element('label',['for',@ics,@java],@_);
}

sub option {
  print plain_element('option',['value',@ics,@java],@_);
}

sub selection {
  my ($tab,$options,$opt) = @_;
  my $tag = 'select';
  my $open = open_tag($tag,$opt,['name','multiple',@ics,@java]);

  label($tab,@{$opt->{label}}) if ($opt->{label} && $opt->{place_label} eq 'before');
  line($tab,qq(<$open>));
  for (@$options) {
    option($tab + 1,@$_);
  }
  line($tab,qq(</$tag>));
  label($tab,@{$opt->{label}}) if ($opt->{label} && $opt->{place_label} eq 'after');
}

sub textarea {
  my ($tab,$value,$opt) = @_;
  my $tag = 'textarea';
  my $open = open_tag($tag,$opt,['name','rows','cols',@ics,@java]);
  
  label($tab,@{$opt->{label}}) if ($opt->{label} && $opt->{place_label} eq 'before');
  line($tab,"<$open>$value</$tag>");
  label($tab,@{$opt->{label}}) if ($opt->{label} && $opt->{place_label} eq 'after');
}

# I have to rewrite input so it can print a list of inputs for check boxes and radio boxes.

sub input {
  my ($tab,$opt) = @_;
  my $tag = 'input';
  my $open = open_tag($tag,$opt,['type','value','name',@ics,@java]);
  my $text = $opt->{text} ? "$opt->{text} " : '';
  
  label($tab,@{$opt->{label}}) if ($opt->{label} && $opt->{place_label} eq 'before');
  line($tab,"$text<$open>");
  label($tab,@{$opt->{label}}) if ($opt->{label} && $opt->{place_label} eq 'after');
}

sub legend {
  print plain_element('legend',[@ics,@java],@_);
}

sub fieldset {
  my ($tab,$code,$opt) = @_;
  my $tag = 'fieldset';
  my $open = open_tag($tag,$opt,[@ics,@java]);

  line($tab,qq(<$open>));
  legend($tab,$opt->{legend}) if $opt->{legend};
  &$code;
  line($tab,qq(</$tag>));
}

sub form {
  my ($tab,$code,$opt) = @_;
  my $tag = 'form';
  my $open = open_tag($tag,$opt,['action','method',@ics,@java]);

  line($tab,qq(<$open>));
  &$code;
  line($tab,qq(</$tag>));
}

# End elements for forms.

sub div {
  my ($tab,$code,$opt) = @_;
  my $tag = 'div';
  my $open = open_tag($tag,$opt,[@ics,@java]);

  line($tab,qq(<$open>));
  &$code;
  line($tab,qq(</$tag>));
}

sub pre {
  my ($tab,$code) = @_;
  line(0,'<pre>');
  &$code;
  line(0,'</pre>');
}

# End elements

=head1 NAME

B<HTML::Element> generates HTML tags for most of the HTML elements.

=head1 SYNOPSIS

To use B<Element> to print HTML tags, use the following.

  use Base::HTML::Element qw(
    title heading script anchor paragraph sparagraph list definition_list table
    form fieldset selection input textarea div pre
  );

=head1 ELEMENTS

All of the functions C<print> the elements with the exception of C<anchor> which returns the anchor and C<sparagraph> which returns a paragraph for use in other functions.

As with the Perl community, the HTML community expects some indentation so tabs, the first parameter of every function, are included with each element except where noted.

The last parameter of every element is a hash with named options except where noted. Most elements have the C<id>, C<class>, C<style>, and scripting options (such as C<onclick>). Only the options specific to the element will be noted.

=head2 C<title>

B<C<title>> has a value but no options.

  title($tab, 'My page title'); 

=head2 C<heading>

B<C<heading>> has the heading level, value, and optional parameters.

  heading($tab, 2, 'My second level heading', { 
    id    => 'heading_id',
    class => 'heading_classes',
    style => 'heading_styles'
  });

=head2 C<script>

B<C<script>> has optional parameters which are C<type> and C<src>.

  script($tab,{ 
    type => 'text/javascript', # or other type
    src => 'script.ext'
  });

=head2 C<anchor>

B<C<anchor>> has a value and the optional parameters C<href>, C<target>, and C<title>. C<anchor> does not not get a C<tab>.

  anchor('Anchor text', {
    href   => 'link location',
    target => 'where the link opens',
    title  => 'alternate text',
    id     => 'anchor_id',
    class  => 'anchor_classes',
    style  => 'anchor_styles'
  });

=head2 paragraphs

B<C<paragraph>> and B<C<sparagraph>> have a value and the optional parameter C<separator>.

B<C<paragraph>> prints the paragraph(s), and B<C<sparagraph>> returns the paragraph(s). The C<separator> option allows you to input more than one paragraph per use of this function.

  paragraph($tab, 'My paragraph(s)', { 
    id    => 'paragraph_id',
    class => 'paragraph_classes',
    style => 'paragraph_styles'
    separator => 'paragraph_separator'
  });

=head2 C<list>

B<C<list>> has type, list, and the optional parameters.

C<type> is C<u> for an unordered list or C<o> for an ordered list. The C<list> parameter is an array reference.

  list($tab, 'u', \@list, {
    id    => 'list_id',
    class => 'list_class'
    style => 'list_style,
  });

=head3 Setting up the list items

If you do not want your list items formatted, you can pass your array as is. If you want your list items formatted, the formatted items are also array references with the optional parameter C<inlist>.

  'unformatted value',
  ['formatted value', { 
    id    => 'item_id',
    class => 'item_class',
    style => 'item_style',
    inlist => ['u', \@inner_list, { list options }]
  }],
  'another unformatted value'

=head2 C<definition_list>

I<I have to tear out some code to make it work like the others.>

=head2 C<table>

Before you go any further, if you plan on using a table for layout, B<I<STOP!>> Tables are for tabular data, use L<div|/div> elements to lay out your webpage.

B<C<table>> has the optional parameters of C<caption>, C<cols>, and C<rows>.

C<cols> and C<rows> are array references.

  table($tab, { 
    id      => 'table_id',
    class   => 'table_class',
    style   => 'table_style',
    caption => 'table caption',
    cols    => \@cols,
    rows    => \@rows,
  });

=head3 Setting up the caption

C<caption> is a value, as seen above, or an array refernce. The C<caption> has the optional parameter C<align>.

  ['table caption', {
    id    => 'caption_id',
    class => 'caption_class',
    style => 'caption_style',
    align => 'caption_align'
  }],

=head3 Setting up the columns

Each C<column> is an array reference of hash references and each has the optional parameter C<span>.

  {
    id    => 'col_id',
    class => 'col_class',
    style => 'col_style'
    span  => 2,
  },

=head3 Setting up the rows

Each C<row> is an array reference with C<type>, C<cells>, and optional parameters. You need to know type of cells are in the row.

=over

=item *

C<header> is a row with only headings. There is only one row allowed in C<header>.

=item *

C<data> is a group of rows with only data.

=item *

C<whead> is a group of rows with a heading then data.

=back

  rows => [
    ['header',\@headings, {
      id    => 'header_row_id',
      class => 'header_row_class',
      style => 'header_row_style
    }],
    ['data',\@data {
      id    => 'data_row_id',
      class => 'data_row_class',
      style => 'data_row_style
    }],
    ['whead',\@data_with_heading],
  ],

=head4 Setting up the cells

If you do not want your cells formatted, you can pass your array as is. If you want your cells formatted, the formatted cells are also array references with optional parameters C<list> and C<type_override>. The C<list> option is the same as the C<inlist> option for L<list items|/Setting up the list items>. If you need to override the row type, use C<type_override>.

  'unformatted value',
  ['formatted value', { 
    id    => 'cell_id',
    class => 'cell_class',
    style => 'cell_style',
  }],
  ['list', { 
    id    => 'cell_with_list_id',
    class => 'cell_class',
    style => 'cell_style',
    list => ['u', \@list_in_cell, { list options }]
  }],
  ['formatted value', { 
    id    => 'cell_id',
    class => 'cell_class',
    style => 'cell_style',
    type_override => 'h',
  }],
  'another unformatted value'

=head2 forms

=head3 C<form>

B<C<form>> has code and the optional paramters C<action> and C<method>. C<code> is an anonymous subroutine.

  form($tab, sub {
    ... form elements ...
  }, { 
    action => 'form_action',
    method => 'form_method',
    id     => 'form_id',
    class  => 'form_class',
    style  => 'form_style'
  });

=head3 C<fieldset>

B<C<fieldset>> has code and the optional paramter C<legend>. C<code> is an anonymous subroutine.

  fieldset($tab, sub {
    ... fieldset elements ...
  }, { 
    legend => 'legend_text',
    id     => 'fieldset_id',
    class  => 'fieldset_class',
    style  => 'fieldset_style'
  });
  
=head4 Setting up the legend

The legend can be unformatted as above or formatted as below in an array reference with the optional parameter C<align>.

  legend => ['legend_text', {
    id    => 'legend_id',
    class => 'legend_class',
    style => 'legend_style,
    align => 'legened_align'
  }],

=head3 C<selection>

B<C<selection>> has options and the optional parameters C<name>, C<multiple>, and C<label>.

  selection($tab, \@options, {
    name     => 'select_name',
    multiple => 'multiple',
    label    => ['label text', { 
      for   => 'select_name',
      id    => 'label_id',
      class => 'label_class',
      style => 'label_style'
    }
    id       => 'select_id',
    class    => 'select_class',
    style    => 'select_style'
  });

=head4 Setting up the options

If you do not want your options formatted, all you need to do is pass the text and C<value> of the option. If you want formatting, you need to pass the other optional parameters.

  ['unformatted option', {
    value => 'unformatted'
  }],
  ['formatted option', {
    value => 'formatted',
    id => 'option_id',
    class => 'option_class',
    style => 'option_style'
  }]

=head3 C<input>

I<I need to rewrite it.>

=head3 C<textarea>

B<C<textarea>> a value and the optional parameters C<name>, C<rows>, C<cols>, and C<label>.

  textarea($tab, 'text in the textarea box', {
    name     => 'textarea_name',
    rows     => 100,
    cols     => 100,
    label    => ['label text', { 
      for   => 'textarea_name',
      id    => 'label_id',
      class => 'label_class',
      style => 'label_style'
    }
    id       => 'textarea_id',
    class    => 'textarea_class',
    style    => 'textarea_style'
  });

=head2 C<div>

B<C<div>> code and optional parameters. C<code> is an anonymous sub.

  div($tab, sub {
    print "Text with out any formatting, great for data dumping."
  }, {
    id    => 'div_id',
    class => 'div_class',
    style => 'div_style'
  });

=head2 C<pre>

B<C<pre>> has code but no optional parameters. The C<tab> will be ignored and C<code> is an anonymous sub.

  pre($tab, sub {
  print "Text without any formatting, great for data dumping."
  });

=head1 AUTHOR

Written by Lady Aleena (Lady underscore Aleena at xecu dot net) with a lot of help from the L<PerlMonks|http://www.perlmonks.org>.

=cut

1;