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
);
####
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, @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 );
}
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, "${upheading}: "
. encode_entities( $definition_list{$term}{$heading} );
}
}
}
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, @java ] );
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, $opt )
= @_;
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, '' );
&$code;
line( 0, '
' );
}
'???';