view release on metacpan or  search on metacpan

t/visit.t  view on Meta::CPAN

#! perl

use v5.20;
use Test2::V0;

use CXC::Data::Visitor '-all';
use Ref::Util 'is_refref', 'is_arrayref';
use Scalar::Util 'refaddr';
use experimental 'signatures', 'postderef', 'lexical_subs';
use Data::Dump 'pp';

sub myhash {
    (
        a => 1,
        b => [ 2, 3, 4 ],
        c => {
            d => [ 5, 6, 7 ],
            e => 8,
        },
    );
}

sub lookup ( $container, $kydx ) {
    return is_arrayref( $container ) ? $container->[$kydx] : $container->{$kydx};
}

sub check_ancestors ( $element, $meta ) {

    my @nodes   = ( $meta->{ancestors}->@*, $element );
    my @indexes = $meta->{path}->@*;

    my $node = shift @nodes;
    while ( @nodes ) {
        my $next  = shift @nodes;
        my $index = shift @indexes;
        is( lookup( $node, $index ), $next, "lookup: $index" );
        $node = $next;
    }
}

subtest 'default' => sub {

    my %hash = myhash;

    my @traversed;

    # see if context works
    my %context = ( traversed => \@traversed );

    my ( $completed ) = visit(
        \%hash,
        sub ( $kydx, $vref, $context, $meta ) {

            subtest $kydx => sub {
                if ( is_refref( $vref ) ) {
                    my $container = lookup( $meta->{container}, $kydx );
                    is( refaddr( $container ), refaddr( $vref->$* ), 'container' );
                    push $context->{traversed}->@*, $kydx;
                }
                else {
                    subtest 'leaf' => sub {
                        my $element = lookup( $meta->{container}, $kydx );
                        is( $element, $vref->$*, "kydx: $kydx => $element" );

                        subtest 'ancestors' => sub {
                            check_ancestors( $element, $meta );
                        };