package HTML::Element;

use strict;
use warnings;
use base qw( 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 );
my (@ics) = qw( id class style );
my (@java) = qw(
    onclick     ondblclick  onkeypress  onkeydown
    onkeyup     onmouseover onmousedown onmouseup
    onmousemove onmouseout
);

sub get_attributes {
    my ( $options, $valid ) = @_;
    my @attributes;
    foreach $_ ( @{ $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>" );
}

sub anchor {
    my ( $value, $opt ) = @_;
    my $tag = 'a';
    my $open
        = open_tag( $tag, $opt, [ 'href', 'target', 'title', @ics, @ja
+va ] );
    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 );
}

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;
    foreach $_ ( grep length($_), split( /$sep/, $value, 0 ) ) {
        $line .= sline( $tab,     "<$open>" );
        $line .= sline( $tab + 1, $_ );
        $line .= sline( $tab,     "</$tag>" );
    }
    return $line;
}

sub paragraph {
    print sparagraph(@_);
}

sub item {
    my ( $tab, $value, $opt ) = @_;
    my $tag = 'li';
    my $open = open_tag( $tag, $opt, [ @ics, @java ] );
    line( $tab,     "<$open>" );
    line( $tab + 1, $value );
    if ( $$opt{'inlist'} ) {
        list( $tab + 1, @{ $$opt{'inlist'}; } );
    }
    line( $tab, "</$tag>" );
}

sub list {
    my ( $tab, $type, $list, $opt ) = @_;
    my $tag = $type . 'l';
    my $open = open_tag( $tag, $opt, [ @ics, @java ] );
    line( $tab, "<$open>" );
    foreach my $item (@$list) {
        if ( ref $item eq 'ARRAY' ) {
            item $tab + 1, $$item[0], $$item[1];
        }
        else {
            item $tab + 1, $item;
        }
    }
    line( $tab, "</$tag>" );
}

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,     "<$open>" );
    line( $tab + 1, $value );
    line( $tab,     "</$tag>" );
}

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, "<$open>" );
    my $term = shift @{ $$opt{'headings'}; };
    foreach 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 {
            foreach my $heading ( @{ $$opt{'headings'}; } ) {
                my $upheading = ucfirst $heading;
                definition $tab + 2, "<b>${upheading}:</b> "
                    . encode_entities( $definition_list{$term}{$headin
+g} );
            }
        }
    }
    line( $tab, "</$tag>" );
}

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, @ja
+va ] );
    line( $tab, "<$open>" );
    if ( $value eq 'list' ) {
        list $tab + 1, @{ $$opt{'list'}; };
    }
    else {
        line( $tab + 1, $value );
    }
    line( $tab, "</$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, "<$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};
    foreach 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, "</$tag>" );
}

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

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

sub table {
    my ( $tab, $opt ) = @_;
    my $tag = 'table';
    my $open = open_tag( $tag, $opt, [ @ics, @java ] );
    line( $tab, "<$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, $_ foreach ( @{ $$opt{'cols'}; } );
    }
    foreach 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 {
            foreach my $row (@rows) {
                row $tab + 1, $type, $_, $attributes foreach (@$row);
            }
        }
    }
    line( $tab, "</$tag>" );
}

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'} and $$opt{'place_label'} eq 'before';
    line( $tab, "<$open>" );
    foreach $_ (@$options) {
        option $tab + 1, @$_;
    }
    line( $tab, "</$tag>" );
    label $tab, @{ $$opt{'label'}; }
        if $$opt{'label'} and $$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'} and $$opt{'place_label'} eq 'before';
    line( $tab, "<$open>$value</$tag>" );
    label $tab, @{ $$opt{'label'}; }
        if $$opt{'label'} and $$opt{'place_label'} eq 'after';
}

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'} and $$opt{'place_label'} eq 'before';
    line( $tab, "$text<$open>" );
    label $tab, @{ $$opt{'label'}; }
        if $$opt{'label'} and $$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, "<$open>" );
    legend $tab, $$opt{'legend'} if $$opt{'legend'};
    &$code;
    line( $tab, "</$tag>" );
}

sub form {
    my ( $tab, $/ root / Desktop / lady . pl . tdy syntax OK code, $op
+t )
        = @_;
    my $tag = 'form';
    my $open = open_tag( $tag, $opt, [ 'action', 'method', @ics, @java
+ ] );
    line( $tab, "<$open>" );
    &$code;
    line( $tab, "</$tag>" );
}

sub div {
    my ( $tab, $code, $opt ) = @_;
    my $tag = 'div';
    my $open = open_tag( $tag, $opt, [ @ics, @java ] );
    line( $tab, "<$open>" );
    &$code;
    line( $tab, "</$tag>" );
}

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