package HTML::Element;
use strict;
use warnings;
use base 'Exporter';
our @EXPORT_OK = qw(title script heading anchor paragraph sparagraph l
+ist 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 onmouseo
+ver 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} <=> $definitio
+n_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($d
+efinition_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 b
+oxes 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_l
+ist table
    form fieldset selection input textarea div pre
  );

=head1 ELEMENTS

All of the functions C<print> the elements with the exception of C<anc
+hor> which returns the anchor and C<sparagraph> which returns a parag
+raph for use in other functions.

As with the Perl community, the HTML community expects some indentatio
+n so tabs, the first parameter of every function, are included with e
+ach element except where noted.

The last parameter of every element is a hash with named options excep
+t 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 par
+ameter 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 th
+an 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 la
+y 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<capt
+ion> 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 t
+he 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 i
+n 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 arra
+y references with optional parameters C<list> and C<type_override>. T
+he C<list> option is the same as the C<inlist> option for L<list item
+s|/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> i
+s 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 arr
+ay 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<mul
+tiple>, 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 igno
+red 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;
[download]