use strict; use warnings; package XHTML::Instrumented::Control; use Params::Validate qw (validate ARRAYREF HASHREF ); sub new() { my $class = shift; my %p = Params::Validate::validate( @_, { src => 0, text => 0, args => 0, replace => 0, remove_tag => 0, remove => 0, id_count => 0, } ); delete $p{remove}; bless({args => {}, @_}, $class); } sub remove_self() { my $self = shift; $self->{remove_tag} || 0; } sub has_name { my $self = shift; exists $self->{args}{name}; } sub name { my $self = shift; $self->{args}{name}; } sub remove() { my $self = shift; $self->{remove}; } sub args { my $self = shift; my %args = @_; my %hash = ( %args, %{$self->{args} || {}} ); if (my $idc = $self->id_count) { if ($hash{for}) { $hash{for} .= '.' . $idc; } if ($hash{id}) { $hash{id} .= '.' . $idc; } } %hash; } sub eq { my $self = shift; my $ret = 0; for my $item (@_) { $ret = 1 if $item eq $self->{text}; } return $ret; } sub if { my $self = shift; !!($self->{text} || keys %{$self->{args} || {}}); } sub _fixup { my @ret; for my $data (@_) { next unless $data; $data =~ s/&/&/g; my $x = $data; # $data = Encode::decode_utf8( $x ); push @ret, $data; } @ret; } ##################### # # # sub exp_args { my $self = shift; die ref($_[0]), caller if ref($_[0]); my %args = $self->args(@_); my $nargs = { %args }; my $ret = join('', map({ defined($nargs->{$_}) ? qq( $_="$nargs->{$_}") : ''; } sort keys(%args))); $ret =~ s/&/&/g; return $ret; } our %special_tag = ( a => 1, div => 1, textarea => 1 ); sub expand_content { my $self = shift; if ($self->{remove}) { return ''; } if (defined $self->{text}) { $self->{text}; } else { @_; } } sub children { my $self = shift; my %p = validate(@_, { children => ARRAYREF, context => { isa => 'XHTML::Instrumented::Context' }, }); my $context = $p{context}; my @ret; for my $element (@{$p{children}}) { if (UNIVERSAL::isa($element, 'XHTML::Instrumented::Entry')) { push(@ret, $element->expand(context => $context)); } else { push(@ret, $element); } } return @ret; } use Data::Dumper; sub to_text { my $self = shift; my %p = validate(@_, { tag => 1, children => ARRAYREF, args => HASHREF, flags => HASHREF, context => { isa => 'XHTML::Instrumented::Context' }, special => 0, }); my $flags = $p{flags}; if ($p{special}) { return @{$p{special}}; } my $args = { %{$p{args}} }; my $test = !!$p{flags}->{if}; my @children; if ($p{flags}->{eq}) { $test++; } if ($test) { # This is only a test of the Entry @children = @{$p{children}}; } else { @children = $self->expand_content(@{$p{children}}); } @children = $self->children(context => $p{context}, children => \@children); if ($self->remove) { return (); } if ($self->remove_self || $flags->{rs}) { return ( @children, ); } my $tag = $p{tag}; #die Dumper \@children if $p{tag} eq 'input' and $p{args}{name} eq 'test2'; my @ret; if ($special_tag{$tag} || @children) { @ret = ('<' . $tag . $self->exp_args(%$args) . '>', @children, ''); } else { @ret = ('<' . $tag . $self->exp_args(%$args) . '/>'); } return @ret; } sub set_id_count { my $self = shift; my $data = shift; $self->{id_count} = $data; } sub id_count { my $self = shift; my $ret; if ($self->in_loop) { $ret = $self->{id_count}; } return $ret; } sub in_loop { my $self = shift; defined $self->{id_count}; } sub form { undef; } sub required { shift; @_; } sub set_tag { my $self = shift; my %p = @_; $self->{tag} = $p{tag}; $self->{_args} = { %{$p{args} || {}}, %{$self->{args} || {}} }; } package XHTML::Instrumented::Control::Dummy; use base 'XHTML::Instrumented::Control'; sub if { 0; } sub is_dummy { 1; } 1; __END__ =head1 NAME XHTML::Instrumented::Control - This object is used to control an Entry object =head1 SYNOPSIS This is used internally by XHTML::Instrumented. =head1 DESCRIPTION This is used internally by XHTML::Instrumented. =head1 API How this object is used. =over =item new =back =head2 Methods =over =item remove_self() =item remove() =item args =item eq =item if =item _fixup =item exp_args Get the arguments for the tag. =item expand_content =item children =item to_text =item set_id_count =item id_count =item form =item required =item if =item is_dummy =item in_loop =item has_name =item name =item set_tag This methods sets the tag for the control element for testing. =back =head2 Functions This Object has no functions. =head1 AUTHOR "G. Allen Morris III" =cut