The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl

use 5.010;
use strict;
use warnings;

use Class::C3;
use MRO::Compat;

use IO::Socket::INET;
use IO::Handle;

use Tapper::Schema::TestTools;
use Test::Fixture::DBIC::Schema;
use Tapper::Reports::Receiver::Daemon;
use Tapper::Model 'model';
use File::Slurp 'slurp';
use Tapper::Config;
use HTTP::Daemon;

use Test::More;
use Test::Deep;

use Log::Log4perl;

my $string = "
log4perl.rootLogger           = INFO, root
log4perl.appender.root        = Log::Log4perl::Appender::Screen
log4perl.appender.root.stderr = 1
log4perl.appender.root.layout = SimpleLayout";
Log::Log4perl->init(\$string);

# -----------------------------------------------------------------------------------------------------------------
construct_fixture( schema  => testrundb_schema,  fixture => 't/fixtures/testrundb/testrun_with_preconditions.yml' );
construct_fixture( schema  => reportsdb_schema,  fixture => 't/fixtures/reportsdb/report.yml' );
# -----------------------------------------------------------------------------------------------------------------

local $ENV{TAPPER_CONFIG_FILE} = "t/tapper.cfg";
Tapper::Config->_switch_context();

sub start_reports_receiver
{
        my ($port) = @_;

        Tapper::Reports::Receiver->new->run($port);
}

sub start_codespeed
{
        my ($PARENT_RDR, $CHILD_WTR, $CHILD_RDR, $PARENT_WTR) = @_;

        close $CHILD_RDR; close $CHILD_WTR;

        $SIG{CHLD} = 'IGNORE';
        my $d = HTTP::Daemon->new(LocalPort => 8765, ReuseAddr => 1) || die "No HTTP daemon:$!";

        # the parent waits for that message
        say $PARENT_WTR "HTTP::Daemon (fake codespeed) started.";

        my $nr = 1;
        while (my $c = $d->accept) {
                while (my $r = $c->get_request) {
                        $c->send_response("0xAFFE");
                        say $PARENT_WTR "$nr - ".$r->uri->path;
                        $nr++;
                }
                $c->close;
                undef($c);
        }
        close $PARENT_RDR; close $PARENT_WTR;
        exit 1;
}

sub send_tap_report
{
        my ($port, $taptxt) = @_;

        my $sock = IO::Socket::INET->new( PeerAddr  => 'localhost', Proto     => 'tcp',
                                          PeerPort  => $port,       ReuseAddr => 1,
                                        ) or die $!;
        is(ref($sock), 'IO::Socket::INET', "socket created - codespeed");
        my $answer = <$sock>;
        like ($answer,
              qr/^Tapper::Reports::Receiver\. Protocol is TAP\. Your report id: (\d+)/,
              "receiver api - codespeed");

        my $success = $sock->print( $taptxt );
        close $sock; # must! --> triggers the daemon's post_processing hook
}

sub check_level2_receiver
{
        my ($PARENT_RDR, $CHILD_WTR, $CHILD_RDR, $PARENT_WTR) = @_;

        my $line;
        chomp($line = <$CHILD_RDR>); is ($line, "1 - /result/add/", "request $line appeared at level2 receiver");
        chomp($line = <$CHILD_RDR>); is ($line, "2 - /result/add/", "request $line appeared at level2 receiver");
        chomp($line = <$CHILD_RDR>); is ($line, "3 - /result/add/", "request $line appeared at level2 receiver");
        chomp($line = <$CHILD_RDR>); is ($line, "4 - /result/add/", "request $line appeared at level2 receiver");
        close $CHILD_RDR; close $CHILD_WTR;
}

my $port = Tapper::Config->subconfig->{report_port};

my $pid1_receiver = fork();
if ($pid1_receiver == 0)
{
        start_reports_receiver($port);
}
else
{
        sleep 10; # wait for receiver daemon to start

        # communicate back to test program via pipe
        my ($PARENT_RDR, $CHILD_WTR, $CHILD_RDR, $PARENT_WTR);

        pipe($PARENT_RDR, $CHILD_WTR);
        pipe($CHILD_RDR, $PARENT_WTR);
        $CHILD_WTR->autoflush(1);
        $PARENT_WTR->autoflush(1);

        my $pid2_codespeed = fork;
        die "No fork: $!" unless defined $pid2_codespeed;
        if ($pid2_codespeed == 0) {
                start_codespeed($PARENT_RDR, $CHILD_WTR, $CHILD_RDR, $PARENT_WTR);
        }
        else
        {
                close $PARENT_RDR; close $PARENT_WTR;
                eval {
                        local $SIG{ALRM} = sub { die "Timeout! Starting codespeed failed!" };
                        alarm (50);
                        diag "Wait until daemon started...";
                        my $wait_for_answer = <$CHILD_RDR>;
                };
                alarm(0);
                ok (!$@, "Fake codespeed daemon started");

                eval {
                        local $SIG{ALRM} = sub { die "Timeout!" };
                        alarm (50);
                        my $taptxt = slurp("t/tap-archive-2-codespeed.tap");
                        send_tap_report($port, $taptxt);
                        check_level2_receiver ($PARENT_RDR, $CHILD_WTR, $CHILD_RDR, $PARENT_WTR);

                };
                alarm(0);
                ok (!$@, "Read and write in time - codespeed");
                kill 15, $pid1_receiver, $pid2_codespeed; sleep 3;
                kill  9, $pid1_receiver, $pid2_codespeed;
        }
}

ok(1, "finished");
done_testing();