package My::Util;

use v5.10;
use strict;
use warnings;

use Carp;
use Test2::V0;
use Test::Lib;
use Data::Dump 'pp', 'dd';
use Time::HiRes 'sleep';
use File::Spec::Functions 'rel2abs';

use parent 'Exporter';

use constant LOG_LEVEL => $ENV{P5_TEST_IMAGE_DS9_LOG_LEVEL} // 'warn';

use constant LOG_AS => $ENV{P5_TEST_IMAGE_DS9_LOG_AS} // 'ddp';

use constant M31_FITS     => rel2abs( 'data/m31.fits.gz' );
use constant SNOOKER_FITS => rel2abs( 'data/snooker.fits.gz' );

my %LOG_AS_func;
BEGIN {
    %LOG_AS_func = ( ddp => \&to_ddp, xpa => \&to_xpa );
}

# use Log::Any::Adapter Capture => structured => $LOG_AS_func{ +LOG_AS }, log_level => LOG_LEVEL();

## no critic (Modules::ProhibitAutomaticExportation)
our @EXPORT = qw(
  clear
  dd
  get_fits_header_cards
  load_events
  note_res_error
  pp
  start_up
  test_stuff
  to_xpa
  yesno
  M31_FITS
  SNOOKER_FITS
);

our $verbose = 0;

sub start_up {
    my %args = @_;
    require TestServer;
    my $ds9 = t::TestServer->new( $verbose );
    $ds9->raise();

    my $frames = 0+ !!$args{image} +0+ !!$args{events};

    clear( $ds9 ) if $args{clear};


    $ds9->fits( M31_FITS )
      if $args{image};

    if ( $args{events} ) {
        $ds9->frame( 'new' ) if --$frames;
        load_events( $ds9 );
    }

    return $ds9;
}

sub clear {
    my $ds9 = shift;

    $ds9->frame( delete => 'all' );
    $ds9->frame( 'new' );
}


sub load_events {
    my $ds9 = shift;

    eval {
        $ds9->fits(
            SNOOKER_FITS,
            {
                extname => 'raytrace',
                bin     => [ 'rt_x', 'rt_y' ] } );
        $ds9->bin( factor => 0.025 );
        $ds9->zoom( 0 );
    };
    die $@, pp( $ds9->{res} ) if $@ ne q{};

}

sub test_stuff {
    my ( $ds9, @stuff ) = @_;

    while ( my ( $cmd, $subcmds ) = splice( @stuff, 0, 2 ) ) {
        last if $cmd eq 'stop';

        subtest $cmd => sub {

            while ( my ( $subcmd, $args ) = splice( @$subcmds, 0, 2 ) ) {
                my @subcmd = ( 'ARRAY' eq ref $subcmd ? @$subcmd : $subcmd );
                $subcmd = join( q{ }, @subcmd );

                subtest pp( $subcmd, $args ) => sub {

                    my $out;
                    my $in;
                    my $sleep = 0;

                    if ( ref $args eq 'HASH' ) {
                        $sleep = $args->{sleep} // 0;
                        $out   = $args->{out}   // [];
                        $in    = $args->{in};
                    }
                    else {
                        $out  = $in = $args;
                        $args = {};
                    }
                    $out = [$out] unless 'ARRAY' eq ref $out;

                    my $ret;
                    if ( $args->{recv_only} ) {
                        $ret = recv_only( $ds9, $cmd, \@subcmd, $out );
                        return if !defined $ret || !defined $in;
                    }

                    elsif ( defined $in ) {
                        $ret = send_and_recv( $ds9, $cmd, \@subcmd, $out, $sleep );
                    }
                    else {
                        return send_only( $ds9, $cmd, \@subcmd, $out );
                    }

                    $in = [$in] unless 'ARRAY' eq ref $in;

                    if ( !ref( $ret ) && 1 == @$in ) {
                        is( $ret, $in->[0], 'return' );
                    }
                    elsif ( @$ret == @$in ) {
                        is( $ret, $in, 'return' );
                    }
                    else {
                        fail( 'unexpected return ' . pp( $ret ) );
                    }
                };
            }
        };
    }

}

# for Log::Any::Adapter::Capture
sub to_xpa {
    # level, category, prefix, text, datahash
    my ( undef, undef, undef, $text, $data ) = @_;

    my @cmd
      = $text =~ /set/i ? qw(xpaset -p ImageDS9)
      : $text =~ /get/i ? qw(xpaget ImageDS9)
      :                   return;

    say {*STDERR} ( join q{ }, @cmd, $data->{cmd} );
}

# for Log::Any::Adapter::Capture
sub to_ddp {
    # level, category, prefix, text, datahash
    my ( $level, $category, $prefix, $text, $data ) = @_;

    require DDP;
    my %hash = (
        category => $category,
        prefix   => $prefix,
        text     => $text,
        data     => $data
    );
    &DDP::p( \%hash );
    ();
}

sub note_res_error {
    my $threw = $@;
    my $ds9   = shift;
    note "threw: $threw", 'result: ', pp( $ds9->res );
}

sub send_only {

    my ( $ds9, $cmd, $subcmd, $out ) = @_;

    ok(
        lives {
            $ds9->$cmd( @$subcmd, @$out );
        },
        'set',
    ) or note( $@, pp( $ds9->res ) );
}


sub send_and_recv {
    my ( $ds9, $cmd, $subcmd, $out, $sleep ) = @_;

    ok(
        lives {
            $ds9->$cmd( @$subcmd, @$out );
        },
        'set',
    ) or do { note( $@, pp( $ds9->res ) ); return };

    sleep( $sleep ) if $sleep;

    my $ret;
    ok(
        lives {
            $ret = $ds9->$cmd( @$subcmd );
        },
        'get',
    ) or do { note( $@, pp( $ds9->res ) ); return; };

    return $ret;

}


sub get_fits_header_cards {
    # $_[0] has the fits file; use the alias to avoid copying it.

    my $offset = @_ > 1 ? $_[-1] : 0;
    my @header;
    my $card = q{};

    for ( ; substr( $card, 0, 8 ) ne 'END     ' ; $offset += 80 ) {
        $card = substr( $_[0], $offset, 80 );
        last if length( $card ) != 80;
        push @header, $card if $card !~ /^\s+$/;
    }

    return ( \@header, $offset );
}

sub recv_only {
    my ( $ds9, $cmd, $subcmd, $out ) = @_;

    my $ret;
    ok(
        lives {
            $ret = $ds9->$cmd( @$subcmd, ( defined $out ? @$out : () ) );
        },
        'get',
    ) or do { note( $@, pp( $ds9->res ) ); return };

    return $ret;
}

my %YesNo = (
    'yes' => 1,
    'no'  => 0,
    '0'   => 0,
    '1'   => 1,
);

sub yesno {
    return defined $_[0] ? $YesNo{ $_[0] } : undef;
}

1;
