HTML-TagTree
view release on metacpan or search on metacpan
lib/HTML/TagTree.pm view on Meta::CPAN
return;
}
my @children = @{$self->{children_objs}};
my @rows=();
my @row_objs;
# First collect the rows
foreach my $child_obj (@children) {
if ( (lc $child_obj->{tag}) eq 'tr') {
push @row_objs,$child_obj;
}
elsif ( ($child_obj->{tag} eq 'thead')
|| ($child_obj->{tag} eq 'tbody')
) {
my @headbody_children = @{$child_obj->{children_objs}};
foreach my $child_obj (@headbody_children) {
if ( (lc $child_obj->{tag}) eq 'tr') {
push @row_objs,$child_obj;
}
}
}
}
# Process the rows
foreach my $child_obj (@row_objs) {
next if (! exists $child_obj->{children_objs});
my @possible_tds = @{$child_obj->{children_objs}};
my @row=();
foreach my $possible_td (@possible_tds) {
next if ( ((lc $possible_td->{tag}) ne 'td')
&& ((lc $possible_td->{tag}) ne 'th')
);
if (! exists $possible_td->{content}) {
push @row, undef;
next;
}
my $value = $possible_td->{content};
if ( (ref $value) ne 'ARRAY') {
push @row, undef;
next;
}
push @row, $value->[0];
my $attributes = $possible_td->{attributes};
if ($attributes =~ m/colspan=['"]?(\d+)/i) {
my $colspan = $1;
for (my $i=1; $i<$colspan; $i++) {
# fill in blanks to match colspan
push @row, undef;
}
}
}
push @rows, \@row;
}
return \@rows;
}
sub header{
# This subroutine returns the standard HTML header
my $header = '<?xml version="1.0" encoding="iso-8859-1"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">';
return $header;
}
sub process_select_tag{
my $self = shift;
my $hash = shift;
return undef if ((ref $hash) ne 'HASH');
if (exists $hash->{tag_attributes}) {
$self->process_tag($hash->{tag_attributes});
}
if (exists $hash->{options}) {
if ( (ref $hash->{options}) eq 'HASH') {
my $sort_sub = sub {lc $a cmp lc $b}; # Default sort is alphabetical ingoring case
if (exists $hash->{sort_sub}) {
$sort_sub = $hash->{sort_sub};
}
if (exists $hash->{sort_numeric}) {
$sort_sub = sub {$a <=> $b};
}
if (exists $hash->{sort_reverse_numeric}) {
$sort_sub = sub {$b <=> $a};
}
if (exists $hash->{sort_numeric_by_value}) {
$sort_sub = sub {$hash->{options}{$a} <=> $hash->{options}{$b}};
}
if (exists $hash->{sort_string_by_value}) {
$sort_sub = sub {$hash->{options}{$a} cmp $hash->{options}{$b}};
}
foreach my $option (sort $sort_sub keys %{$hash->{options}}) {
my $content = "<option ";
if ($hash->{options}{$option} eq $hash->{selected}) { # is the option value selected?
$content .= 'selected="selected" ';
}
my $value = $option;
if (not ref ($hash->{options}{$option})) {
$value = $hash->{options}{$option};
}
$content .= "value=\"$value\">$option</option>";
push @{$self->{content}}, $content;
}
}
elsif ( (ref $hash->{options}) eq 'ARRAY') {
foreach my $option ( @{$hash->{options}}) {
my $content = "<option";
if ($option eq $hash->{selected}) {
$content .= ' selected="selected" ';
}
$content .= ">$option</option>";
push @{$self->{content}}, $content;
}
}
}
}
sub create_radio_table{
my $self = shift;
lib/HTML/TagTree.pm view on Meta::CPAN
$valid_empty_tags_for_shortening{$tag} = 1;
}
}
elsif ((ref $tags) eq 'SCALAR') {
$valid_empty_tags_for_shortening{$$tags} = 1;
}
elsif ((ref $tags) eq '') {
$valid_empty_tags_for_shortening{$tags} = 1;
}
}
sub set_valid_tags{
my $self = shift;
my $tags = shift;
%valid_tags = ();
if ((ref $tags) eq 'ARRAY') {
foreach my $tag (@$tags) {
$valid_tags{$tag} = 1;
}
}
elsif ((ref $tags) eq 'HASH') {
foreach my $tag (keys %$tags) {
$valid_tags{$tag} = 1;
}
}
elsif ((ref $tags) eq 'SCALAR') {
$valid_tags{$$tags} = 1;
}
elsif ((ref $tags) eq '') {
$valid_tags{$tags} = 1;
}
}
%preprocess_tag = (
'html' => sub {
my $self = shift;
my $tag = shift;
my $tag_parameters = $self->{parameters};
if ($tag_parameters !~ m/lang=/) {
$self->{parameters} .= ' lang=en-US';
}
}
);
sub get_default_head_meta_attributes{
my $attributes = 'http-equiv="content-type" content="text/html; charset=UTF-8"';
return $attributes;
}
sub get_http_header {
my $return = "Content-type: text/html\n";
$return .= "Status: 200 OK\n\n";
}
sub get_doctype {
my $return = '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"';
$return .= ' "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">';
$return .= "\n\n";
return $return;
}
sub version {
return $VERSION;
}
return 1;
__END__
=head1 NAME
HTML::TagTree - An HTML generator via a tree of 'tag' objects.
=head1 SYNOPSIS
use HTML::TagTree;
my $html = HTML::TagTree->new('html'); # Define the top of the tree of objects.
my $head = $html->head(); # Put a 'head' branch on the tree.
my $body = $html->body(); # Put a 'body' branch on the tree
$head->title("This is the Title of Gary's Page, the opening title...");
$head->meta('', 'name=author CONTENT="Dan DeBrito"');
$body->div->h1('Hello Dolly'); # Example of method chaining to create
# a long branch.
my $table = $body->table('', 'width=100% border=1');
my $row1 = $table->tr();
$row1->td('cell a');
$row1->td('cell b');
$table->tr->td('This is a new row with new cell');
$table->tr->td('This is a another new row with new data');
# Print to STDOUT the actual HTML representation of the tree
$html->print_html();
# Put HTML into a scalar variable
my $html_source = $html->get_html_text();
# Force destruction of object tree
$html->release();
=head1 DESCRIPTION
HTLM::TagTrees allows easy building of a tree objects where
each object represents: 1) a tag 2) its value and 3) any
tag attributes. Valid HTML is build of the tree via a method call.
=head1 FEATURES
Smart quoting of tag parameters:
Doing something like this:
$body->div('','id=nav onclick="alert(\"Hello World\"');
the HTML module will render HTML that looks like:
( run in 1.569 second using v1.01-cache-2.11-cpan-119454b85a5 )