use strict; use warnings; package XHTML::Instrumented::Loop; use base 'XHTML::Instrumented::Control'; use Params::Validate qw (validate ARRAYREF HASHREF); sub new { my $class = shift; my %p = validate(@_, { inclusive => 0, headers => { optional => 1, type => ARRAYREF, }, data => { optional => 1, type => ARRAYREF, depends => [ 'headers' ], }, default => 0, } ); my $self = bless { headers => [], data => [], _count => 0, %p }, $class; for (my $x = 0; $x < @{$self->{headers}}; $x++) { $self->{hash}{ $self->{headers}[$x] } = $x; } return $self; } sub count { my $self = shift; $self->{_count}; } sub inc { my $self = shift; $self->{_count}++; } sub _have_data { my $self = shift; my @data = @{$self->{data}}; if ($self->{_count} >= @data) { $self->{_count} = 0; return 0; } else { return 1; } } sub expand_content { my $self = shift; my @ret = $self->SUPER::expand_content(@_); return @ret; } sub get_id { my $self = shift; my $id = shift; my %hash; my $x = 0; for my $h (@{$self->{headers}}) { $hash{$h} = $x++; } my $data; if (defined $hash{$id}) { if ($self->{_count} >= @{$self->{data}}) { if (ref $self->{default} eq 'ARRAY') { $data = $self->{default}[$hash{$id}]; } else { $data = $self->{default} || 'N/A'; } } else { $data = $self->{data}[$self->{_count}][$hash{$id}]; } } return $data; } sub if { my $count = shift->rows; $count ? 1 : 0; } sub rows { my $self = shift; scalar @{$self->{data}}; } sub children { my $self = shift; my %p = validate(@_, { context => { isa => 'XHTML::Instrumented::Context' }, children => ARRAYREF, }); my @ret; if ($self->inclusive) { my $context = $p{context}->copy; @ret = ($self->SUPER::children(@_, context => $context)); } else { while ($self->_have_data) { my $context = $p{context}->copy; push(@ret, $self->SUPER::children(%p, context => $context)); $self->inc; } } return @ret; } sub to_text { my $self = shift; my %p = validate(@_, { tag => 1, children => ARRAYREF, args => HASHREF, flags => HASHREF, context => { isa => 'XHTML::Instrumented::Context' }, }); my @ret; my $context = $p{context}; # remove the entire loop element branch if no data # TODO This may need an option my $count = $self->rows; die 'if in loop' if (!!$p{flags}->{if}); # A loop never has an if. my $inclusive = $self->inclusive; if ($p{flags}->{ex}) { $inclusive = 0; } if ($p{flags}->{in}) { $inclusive = 1; } if ($count) { if ($inclusive) { my $s = $self->{inclusive}; $self->{inclusive} = $inclusive; my $x = 1; while (my $q = $self->_have_data) { my $x = $context->copy(loop => $self); $x->set_count($self); push @ret, $self->SUPER::to_text(%p, context => $x); $self->inc; } $self->{inclusive} = $s; } else { my $x = $context->copy(loop => $self); push @ret, $self->SUPER::to_text(%p, context => $x); } } return @ret; } sub inclusive { my $self = shift; $self->{inclusive} || 0; } 1; __END__ =head1 NAME XHTML::Instrumented::Loop - This is I Object for loop structures =head1 SYNOPSIS XHTML::Instrumented::Loop inherits from XHTML::Instrumented::Control; =head1 API =head2 Constructor =over =item new headers => [], data => [[]], inclusive => I, default => I =back =head2 Methods =over =item count =item inc =item _have_data =item get_id =item if =item rows =item children =item to_text =item inclusive =item expand_content =back =head2 Functions =over =back =head1 AUTHOR "G. Allen Morris III" =cut