The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Test::Hyper::Control;

use strict;
use warnings;

use base qw(Test::Class::Hyper);
use Test::More;
use Test::Exception;
use Storable qw(freeze thaw);

sub setup :Test(startup => 1) {
    use_ok('Hyper::Control');
}

sub default :Test(7) {
    ok(
        my $control = Hyper::Control->new()
            => 'initializing'
    );
    ok( $control->get_value_recursive([qw(this)])
            => 'get_value_recursive(this)' );
    ok( ! $control->get_value_recursive([qw(this dispatch)])
            => 'get_value_recursive(this dispatch)' );
    ok( ! $control->get_value_recursive([qw(dispatch)])
            => 'get_value_recursive(dispatch)' );

    $control->set_dispatch(undef);
    ok( thaw(freeze($control)) => 'freeze / thaw' );
    ok( $control->set_value_recursive([qw(this dispatch)], 'TEST')
            => 'set_value_recursive(this dispatch) => TEST' );
    ok( $control->get_value_recursive([qw(this dispatch)]) eq 'TEST'
            => 'set_value_recursive(this dispatch) eq TEST' );
}

sub set_value_recursive :Test(9) {
    ok( my $control = Hyper::Control->new()
            => 'initializing' );

    my $hash_ref = {};
    *Hyper::Control::get_hash_ref = sub { return $hash_ref; };
    ok ( $control->set_value_recursive(
             [qw(this hash_ref add key now)],
             'test',
         ) => 'hash ref based set_value_recursive'
    );
    ok( $control->get_value_recursive(
            [qw(this hash_ref add key now)]
        ) eq 'test'
            => 'hash ref based get_value_recursive'
    );
    my $nothing;
    *Hyper::Control::get_undef  = sub { return $nothing; };
    *Hyper::Control::set_undef  = sub { $nothing = $_[1]; };
    ok ( $control->set_value_recursive(
             [qw(this undef test value)],
             'test',
         ) => 'set method -> autovivification'
    );
    ok( $control->get_value_recursive(
            [qw(this undef test value)]
        ) eq 'test'
            => 'get modified'
    );
    ok( $control->get_value_recursive(
            [qw(this undef test value)]
        ) eq $nothing->{test}->{value}
            => ' compare with original var'
    );

    *Hyper::Control::get_control  = sub { return $control; };
    ok ( $control->set_value_recursive(
             [qw(this control dispatch test value)],
             'test',
         ) => 'set method -> object -> autovivification'
    );
    ok( $control->get_value_recursive(
            [qw(this control dispatch test value)]
        ) eq 'test'
            => 'get modified'
    );
    ok ( $control->get_dispatch()->{test}->{value} eq 'test'
             => 'compare with original var'
    );
}

sub dispatch :Test(5) {
    ok( my $control = Hyper::Control->new({
            dispatch => 'Hyper::Control'
        })
            => 'initializing' );

    throws_ok(
        sub { thaw(freeze($control)) },
        qr{can't find method >DISPATCH< in class >Hyper::Control<}msi,
        'throws ok on invalid DISPATCH',
    );

    my $DISPATCH_called;
    *Hyper::Control::DISPATCH = sub { $DISPATCH_called = 1; };
    ok( ! $DISPATCH_called, 'DISPATCH not called after initialize' );
    ok( my $thawn = thaw(freeze($control))
            => 'freeze / thaw' );
    ok( $DISPATCH_called, 'DISPATCH called after thaw' );
}

1;