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" ); } sub anchor { my ( $value, $opt ) = @_; my $tag = 'a'; my $open = open_tag( $tag, $opt, [ 'href', 'target', 'title', @ics, @java ] ); return "<$open>$value"; } sub title { my ( $tab, $value, $opt ) = @_; my $tag = 'title'; my $open = $tag; line( $tab, "<$open>$value" ); } sub script { my ( $tab, $opt ) = @_; my $tag = 'script'; my $open = open_tag( $tag, $opt, [ 'type', 'src' ] ); line( $tab, "<$open>" ); } 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, "" ); } 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, "" ); } 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, "" ); } 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, "" ); } 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, "" ); } 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, "" ); } 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, "" ); } 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, "" ); } 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, "" ); 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" ); 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, "" ); } 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, "" ); } sub div { my ( $tab, $code, $opt ) = @_; my $tag = 'div'; my $open = open_tag( $tag, $opt, [ @ics, @java ] ); line( $tab, "<$open>" ); &$code; line( $tab, "" ); } sub pre { my ( $tab, $code ) = @_; line( 0, '
' );
    &$code;
    line( 0, '
' ); } '???';