package Test::Stream::Compare::Array; use strict; use warnings; use base 'Test::Stream::Compare'; use Test::Stream::HashBase accessors => [qw/inref ending items order/]; use Carp qw/croak confess/; use Scalar::Util qw/reftype looks_like_number/; sub init { my $self = shift; if(my $ref = $self->{+INREF}) { croak "Cannot specify both 'inref' and 'items'" if $self->{+ITEMS}; croak "Cannot specify both 'inref' and 'order'" if $self->{+ORDER}; croak "'inref' must be an array reference, got '$ref'" unless reftype($ref) eq 'ARRAY'; my $order = $self->{+ORDER} = []; my $items = $self->{+ITEMS} = {}; for (my $i = 0; $i < @$ref; $i++) { push @$order => $i; $items->{$i} = $ref->[$i]; } } else { $self->{+ITEMS} ||= {}; croak "All indexes listed in the 'items' hashref must be numeric" if grep { !looks_like_number($_) } keys %{$self->{+ITEMS}}; $self->{+ORDER} ||= [sort { $a <=> $b } keys %{$self->{+ITEMS}}]; croak "All indexes listed in the 'order' arrayref must be numeric" if grep { !(looks_like_number($_) || (ref($_) && reftype($_) eq 'CODE')) } @{$self->{+ORDER}}; } $self->SUPER::init(); } sub name { '' } sub verify { my $self = shift; my %params = @_; return 0 unless $params{exists}; my $got = $params{got} || return 0; return 0 unless ref($got); return 0 unless reftype($got) eq 'ARRAY'; return 1; } sub top_index { my $self = shift; my @order = @{$self->{+ORDER}}; while(@order) { my $idx = pop @order; next if ref $idx; return $idx; } return undef; # No indexes } sub add_item { my $self = shift; my $check = pop; my ($idx) = @_; my $top = $self->top_index; croak "elements must be added in order!" if $top && $idx && $idx <= $top; $idx = defined($top) ? $top + 1 : 0 unless defined($idx); push @{$self->{+ORDER}} => $idx; $self->{+ITEMS}->{$idx} = $check; } sub add_filter { my $self = shift; my ($code) = @_; croak "A single coderef is required" unless @_ == 1 && $code && ref $code && reftype($code) eq 'CODE'; push @{$self->{+ORDER}} => $code; } sub deltas { my $self = shift; my %params = @_; my ($got, $convert, $seen) = @params{qw/got convert seen/}; my @deltas; my $state = 0; my @order = @{$self->{+ORDER}}; my $items = $self->{+ITEMS}; # Make a copy that we can munge as needed. my @list = @$got; while (@order) { my $idx = shift @order; my $overflow = 0; my $val; # We have a filter, not an index if (ref($idx)) { @list = $idx->(@list); next; } confess "Internal Error: Stacks are out of sync (state > idx)" if $state > $idx + 1; while ($state <= $idx) { $state++; $overflow = !@list; $val = shift @list; } confess "Internal Error: Stacks are out of sync (state != idx + 1)" unless $state == $idx + 1; my $check = $convert->($items->{$idx}); push @deltas => $check->run( id => [ARRAY => $idx], convert => $convert, seen => $seen, exists => !$overflow, $overflow ? () : (got => $val), ); } # if items are left over, and ending is true, we have a problem! if($self->{+ENDING} && @list) { while (@list) { my $item = shift @list; push @deltas => $self->delta_class->new( dne => 'check', verified => undef, id => [ARRAY => $state++], got => $item, check => undef, ); } } return @deltas; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test::Stream::Compare::Array - Internal representation of an array comparison. =head1 DEPRECATED B in favor of L, L, and L. See L for a conversion guide. =head1 DESCRIPTION This module is an internal representation of an array for comparison purposes. =head1 METHODS =over 4 =item $ref = $arr->inref() If the instance was constructed from an actual array, this will have the reference to that array. =item $bool = $arr->ending =item $arr->set_ending($bool) Set this to true if you would like to fail when the array being validated has more items than the check. That is if you check indexes 0-3, but the array received has values for indexes 0-4, it will fail and list that last item in the array as unexpected. If this is false then it is assumed you do not care about extra items. =item $hashref = $arr->items() =item $arr->set_items($hashref) This gives you the hashref of C<< key => val >> pairs to be checked in the array. This is a hashref so that indexes can be skipped if desired. B that there is no validation when using C, it is better to use the C interface. =item $arrayref = $arr->order() =item $arr->set_order($arrayref) This gives you an arrayref of all indexes that will be checked, in order. B that there is no validation when using C, it is better to use the C interface. =item $name = $arr->name() Always returns the string C<< "" >>. =item $bool = $arr->verify(got => $got, exists => $bool) Check if C<$got> is an array reference or not. =item $idx = $arr->top_index() Get the topmost index that gets checked. This will return undef if there are no items, C<0> is returned if there is only 1 item. =item $arr->add_item($item) =item $arr->add_item($idx => $item) Add an item to the list of values to check. If index is omitted then the next index after the last is used. =item $arr->add_filter(sub { ... }) Add a filter sub. The filter receives all remaining values of the array being checked, and should return the values that should still be checked. The filter will be run between the last item added and the next item added. =item @deltas = $arr->deltas(got => $got, convert => \&convert, seen => \%seen) Find the differences between the expected array values and those in the C<$got> arrayref. =back =head1 SOURCE The source code repository for Test::Stream can be found at F. =head1 MAINTAINERS =over 4 =item Chad Granum Eexodist@cpan.orgE =back =head1 AUTHORS =over 4 =item Chad Granum Eexodist@cpan.orgE =back =head1 COPYRIGHT Copyright 2015 Chad Granum Eexodist7@gmail.comE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F =cut