The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;
use Test::More;
use Data::Dumper qw/Dumper/;

use Data::Context::Util qw/lol_path lol_iterate do_require/;

my ($data, $tests) = get_data();
test_lol_path();
test_lol_iterate();
test_do_require();

done_testing;

sub test_lol_path {

    for my $path ( keys %$tests ) {
        is lol_path($data, $path)
            , $tests->{$path}
            , "lol_path '$path' returns ".(defined $tests->{$path} ? "'$tests->{$path}'" : 'undef');
    }

    my $replacer;
    my $data = Data::Context::Util::lol_path( {}, 'a' );
    is_deeply $data, undef, 'Non-existant path returns undef';

    $data = Data::Context::Util::lol_path( { b => [] }, 'a.b' );
    is_deeply $data, undef, 'Non-existant path returns undef';

    $data = Data::Context::Util::lol_path( { b => [] }, 'b' );
    is_deeply $data, [], 'get hash value';

    $data = Data::Context::Util::lol_path( { b => [1] }, 'b.0' );
    is_deeply $data, 1, 'Get array value';

    $data = Data::Context::Util::lol_path( [2], '0' );
    is_deeply $data, 2, 'Get value from array lol';

    eval { $data = Data::Context::Util::lol_path( [\'str ref'], '0.a' ); };
    my $error = $@;
    like $error, qr/^Don't know how to deal with SCALAR/, 'Error on scalar ref';

    eval { $data = Data::Context::Util::lol_path( [Dummy->new(data => {})], '0.a' ); };
    $error = $@;
    like $error, qr/^Don't know how to deal with Dummy/, 'Error on object with no accessor';

    my $raw = [{ replace => 'me'}];
    ($data, $replacer) = Data::Context::Util::lol_path( $raw, '0' );
    is_deeply $data, { replace => 'me'}, 'Get value from array lol';
    $data = $replacer->(['my data']);
    is_deeply $raw, [['my data']], 'Replace sub path data with replacer'
        or diag explain $raw, $data;

    ($data, $replacer) = Data::Context::Util::lol_path( $raw, '' );
    $data = $replacer->(['my data']);
    is_deeply $raw, ['my data'], 'Replace all data ARRAY with replacer'
        or diag explain $raw, $data;

    $raw = { b => 2 };
    ($data, $replacer) = Data::Context::Util::lol_path( $raw, '' );
    $data = $replacer->({ a => 1 });
    is_deeply $raw, { a => 1 }, 'Replace all data HASH with replacer'
        or diag explain $raw, $data;

    $raw = '';
    ($data, $replacer) = Data::Context::Util::lol_path( $raw, '' );
    eval { $replacer->({ a => 1 }); };
    $error = $@;
    like $error, qr/^Can't replace ''!/, 'Error on object with no accessor';

    $data = Data::Context::Util::lol_path( $raw, '' );
    is_deeply $data, $raw, 'Get what I put in back';
}

sub test_lol_iterate {
    my %result;
    lol_iterate(
        $data,
        sub {
            my ( $data, $path ) = @_;
            $result{$path} = $data if $path;
        }
    );

    for my $path ( keys %$tests ) {
        is $result{$path}, $tests->{$path}, "lol_iterate saw '$path' had a value of '".(defined $tests->{$path} ? $tests->{$path} : '')."'";
    }

    # iterate over constant data
    %result = ();
    lol_iterate(
        1,
        sub {
            my ( $data, $path ) = @_;
            $result{$path || ''} = $data;
        }
    );
    is_deeply {''=>1}, \%result, "Iterate over constant object ok";

    # itterate over null data
    %result = ();
    lol_iterate(
        undef,
        sub {
            my ( $data, $path ) = @_;
            $result{$path || ''} = $data;
        }
    );
    is_deeply {}, \%result, "Iterate over undefined object without path ok";

    # with a defined path
    lol_iterate(
        undef,
        sub {
            my ( $data, $path ) = @_;
            $result{$path || ''} = $data;
        },
        'path'
    );
    is_deeply {}, \%result, "Iterate over undefined object with path ok"
        or note Dumper \%result;
}

sub test_do_require {
    eval { do_require('123::B456'); };
    ok $@, 'Get error loading bad module';
}

sub get_data {
    return (
        {
            a => "A",
            b => [
                {
                    b_a => "B A",
                },
                {
                    b_b => [
                        {
                            b_b_a => "B B A",
                        },
                        {
                            b_b_b => "B B B",
                        },
                    ],
                },
            ],
            c => Dummy->new(
                data => {
                    'c_a' => 'C A',
                }
            ),
            d => bless [], 'other object',
        },
        {
            'a'               => 'A',
            'b.0.b_a'         => "B A",
            'b.1.b_b.1.b_b_b' => "B B B",
            'c.data.c_a'      => 'C A',
            'e'               => undef,
            'b.1.b_b.1.b_b_e' => undef,
            'b.1.b_b.2.b_b_e' => undef,
            'b.1.b_b.1.._b_e' => undef,
            'a.0'             => undef,
        }
    );
}

package Dummy;

use Moose;

BEGIN {
    has data => (
        is  => 'rw',
        isa => 'HashRef',
    );
};