The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package JSTAPd::Server;
use strict;
use warnings;
use AE;
use Data::Dumper;
use File::ShareDir;
use File::Spec;
use JSON::XS;
use HTTP::Request;
use LWP::UserAgent;
use Path::Class;
use Time::HiRes;

use Plack::App::Directory;
use Plack::Builder;
use Plack::Request;
use Plack::Response;
use Plack::Runner;

use JSTAPd;
use JSTAPd::ContentsBag;
use JSTAPd::Server::Contents;
use JSTAPd::TAP;

sub contents { $_[0]->{contents} }
sub conf { $_[0]->{conf} }
sub jstapd_prefix { $_[0]->{conf}->{jstapd_prefix} }
sub run_once { !!$_[0]->{run_file} }
sub auto_open { !!$_[0]->{conf}->{auto_open_command} }

sub new {
    my($class, %opts) = @_;

    my $self = bless {
        dir  => '.',
        port => 1978,
        host => '127.0.0.1',
        session_tap => +{},
        stdout => *STDOUT,
        %opts,
    }, $class;
    $self->{dir} = Path::Class::Dir->new( $self->{dir} );
    $self->{contents} = JSTAPd::ContentsBag->new( dir => $self->{dir}, run_file => $self->{run_file} );
    $self->{contents}->load;
    $self->load_config;
    $self;
}

sub load_config {
    my $self = shift;
    my $path = $self->{dir}->file('conf.pl');
    my $hash = do $path;
    if (defined $hash && ref($hash) ne 'HASH') {
        die "$path return data is not HASHref";
    }
    $hash ||= +{};

    $hash->{auto_open_command} = $ENV{JSTAP_AUTO_OPEN_COMMAND} if $ENV{JSTAP_AUTO_OPEN_COMMAND};

    $self->{conf} = {
        jstapd_prefix => '____jstapd',
        urlmap       => +[],
        apiurl       => undef,
        %{ $hash },
    };
}

sub run {
    my $self = shift;

    my $uri = sprintf 'http://%s:%s/%s/', $self->{host}, $self->{port}, $self->{conf}->{jstapd_prefix};
    if ($self->auto_open) {
        if (my $pid = fork) {
            # running to server
        } elsif (defined $pid) {
            # waiting http server startup
            while (1) {
                sleep 0.01;
                my $res = LWP::UserAgent->new->request(
                    HTTP::Request->new( GET => $uri )
                    );
                last if $res->code == 200;
            }

            # open the browser
            my $cmd = sprintf($self->conf->{auto_open_command}, $uri);
            `$cmd`;
            exit;
        } else {
            die 'browser auto open mode is fork error';
        }
    }

    my $env = 'development';
    $env = 'jstapd_auto_open' if $self->auto_open;
    my $runner = Plack::Runner->new(
        env     => $env,
        server  => 'Twiggy',
        options => [
            host => $self->{host},
            port => $self->{port},
        ],
    );
    print STDERR "starting: $uri\n" unless $self->auto_open;

    my $contents_htroot = sprintf '/%s/contents', $self->jstapd_prefix;
    my $share_htroot = sprintf '/%s/share', $self->jstapd_prefix;
    my $share_root   = eval { File::ShareDir::dist_dir('JSTAPd') } || do {
        my @dirs = File::Spec->splitdir($INC{'JSTAPd.pm'});
        pop @dirs; pop @dirs;
        File::Spec->catfile(@dirs, 'share');
    };

    my $jstapd_app   = $self->psgi_app;
    my $contents_dir = Plack::App::Directory->new( root => $self->{dir} )->to_app;
    my $contents_app = sub {
        my $path_info = $_[0]->{PATH_INFO};
        return $contents_dir->(@_) unless $path_info =~ /\.t\z/;
        $jstapd_app->(@_);
    };

    my $app = builder {
        mount "$share_htroot"    => Plack::App::Directory->new( root => $share_root )->to_app;
        mount "$contents_htroot" => $contents_app,
        mount "/"                => $jstapd_app;
    };
    $runner->run( $app->to_app );
}

sub psgi_app {
    my $self = shift;
    return sub {
        my $res = $self->handler(@_);
        return $res unless ref $res eq 'Plack::Response';
        return $res->finalize();
    };
}

sub setup_session_tap {
    my($self, $session, $path) = @_;
    $self->{session_tap}->{$session} ||= +{
        current_path => undef,
        path         => +{},
    };
    if ($path) {
        return $self->{session_tap}->{$session}->{path}->{$path} ||= +{
            is_end => 0,
            tap    => JSTAPd::TAP->new,
            ajax_request_stack => +[],
        };
    } else {
        return $self->{session_tap}->{$session};
    }
}
sub get_session {
    $_[0]->setup_session_tap($_[1]);
}
sub get_path {
    $_[0]->setup_session_tap($_[1], $_[2]);
}
sub get_tap {
    $_[0]->get_path($_[1], $_[2])->{tap};
}

sub decode_urlmap {
    my($self, $path) = @_;
    my $urlmap = $self->{conf}->{urlmap};
    for my $conf (@{ $urlmap }) {
        my($re, $new) = %{ $conf };
        last if $path =~ s/$re/$new/;
    }
    $path;
}

sub handler {
    my($self, $env) = @_;

    my $req = Plack::Request->new($env);

    my $session = $req->param('session') || Data::UUID->new->create_hex;

    my $jstapd_prefix = $self->{conf}->{jstapd_prefix};
    my $apiurl        = $self->{conf}->{apiurl};
    my $res;
    if ($req->uri->path eq '/favicon.ico') {
    } elsif (my($path) = $req->uri->path =~ m!^/$jstapd_prefix/(.+)?$!) {
        # serve jstapd contents
        $path = 'index' unless $path;
        $path .= 'index' if $path =~ m!/$! || !$path;
        $self->get_session($session)->{current_path} ||= do {
            my $p = $path;
            $p =~ s{^contents/}{};
            $p;
        };
        $res = JSTAPd::Server::Contents->handler($path, $self, $req, $session);

        # no-cache
        $res->header( 'Pragma' => 'no-cache' );
        $res->header( 'Cache-Control' => 'no-cache' );

        # set test session cookie
        if ($path eq 'index' || $path =~ /\.t$/) {
            $res->cookies->{$jstapd_prefix} = {
                value => $session,
                path  => '/',
            };
        }
    } elsif (($path) = $req->uri->path =~ m!^/${jstapd_prefix}__api/(.+)?$!) {
        # ajax request for jstapd
        $res = $self->api_handler($path, $req, $session);
        $res ||= Plack::Response->new( 200, [ 'Content-Type' => 'application/json' ], '{msg:"ok"}' );

    } elsif ($apiurl && $req->uri->path =~ /$apiurl/) {
        # ajax request for appication
        $session = $req->cookies->{$jstapd_prefix};
        my $current_path = $self->get_session($session)->{current_path};
        $res = JSTAPd::Server::Contents->handler("contents/$current_path", $self, $req, $session, { path => $current_path, is_api => 1 });

        # push request
        my $param = $req->parameters->as_hashref_mixed;
        my $current = $self->get_path($session, $current_path);
        push @{ $current->{ajax_request_stack} }, +{
            method => $req->method,
            path   => $req->uri->path,
            query  => $req->uri->query,
            param  => $param,
        };
        if ($current->{pop_tap_request}) {
            # send waiting request
            my $stack = $current->{ajax_request_stack} || +[];
            $stack = [ splice @{ $stack }, 0, $current->{pop_tap_request}->{requests} ];
            $current->{pop_tap_request}->{cv}->send(
                $self->json_response($stack)
            );
        }
    } else {
        # ajax request?
        my $path = $self->decode_urlmap($req->uri->path);
        # XXX Content-Type?
        $res = Plack::Response->new( 200, [], $self->{dir}->file($path)->slurp.'' );
    }

    return $res || Plack::Response->new( 404, [ 'Content-Type' => 'text/plain' ], 'Not Found' );
}

sub api_handler {
    my($self, $type, $req, $session) = @_;

    # for main index
    my $current_path = $self->get_session($session)->{current_path};
    if (my $code = JSTAPd::Server::controller->can($type)) {
        my $ret = $code->($self, $session, $req, $current_path);
        return $ret if $ret;
    }

    # for tap test
    my $path = $req->param('path');
    my @session_path = ($session, $path);

    my $tap = $self->get_tap(@session_path);
    my $current = $self->get_path(@session_path);
    if ($type eq 'tests') {
        $tap->tests($req->param('num'));
    } elsif ($type eq 'tap') {
        $tap->push_tap($req->parameters);
    } elsif ($type eq 'tap_done') {
        if (my $error = $req->param('error')) {
            $tap->error($error);
        }
        if ($current->{end_cv}) {
            $current->{end_cv}->send();
        }
        $self->get_path(@session_path)->{is_end} = 1;
        return Plack::Response->new( 200, [ 'Content-Type' => 'text/plain' ], $tap->as_string );
    } elsif ($type eq 'dump') {
        warn Dumper($tap);
    }
    return;
}

sub json_response {
    my $res;
    eval {
        $res = Plack::Response->new( 200, ['Content-Type' => 'application/json' ], JSON::XS->new->ascii->encode($_[1]) );
    };
    if ($@) {
        warn Dumper($_[1]);
        warn $@;
    }
    $res;
}


sub set_tests {
    my($self, $session, $path) = @_;
    my $tap = $self->get_tap($session, $path);
    $self->{contents}->visitor(sub{
        my $obj = shift;
        my $child = $obj->{child};
        return unless ref $child eq 'JSTAPd::Contents';
        next unless $child->can('suite');
        my $suite = $child->suite;
        return unless $suite;
        return unless $path eq $obj->{path};
        $tap->tests($suite->tests) unless $tap->tests;
    });
}

package JSTAPd::Server::controller;

sub get_test_plans {
    my($c, $session, $req, $current_path) = @_;
    return $c->json_response($c->contents->test_plans);
}

sub get_next {
    my($c, $session, $req, $current_path) = @_;
    my $next_path = -1;
    if ($c->run_once) {
        # for prove -vl jstap/foor/01_test.t
        # or prove -vlr jstap
        $next_path = $c->get_session($session)->{current_path} = $c->{run_file}.'' unless $current_path;
        $c->set_tests($session, $next_path);
        return $c->json_response(+{
            session => $session,
            path    => $next_path,
        });
    }

    my $is_next = $current_path ? 0 : 1;
    my $is_last = 0;
    $c->{contents}->visitor(sub{
        return if $is_last;
        my $args = shift;
        return if $args->{is_dir};
        return unless $args->{name} =~ /\.t$/;
        if ($is_next) {
            $next_path = $args->{path};
            $is_last++;
            return;
        }
        if ($current_path eq $args->{path}) {
            $is_next++;
        }
    });
    $c->set_tests($session, $next_path);
    $c->get_session($session)->{current_path} = $current_path = $next_path;
    return $c->json_response(+{
        session => $session,
        path    => "$current_path",
    });
}

sub watch_finish {
    my($c, $session, $req, $current_path) = @_;

    my @session_path = ($session, $current_path);
    my $current = $c->get_path(@session_path);
    if ($current_path && $current) {
        # 終了までまってるなり
        if ($current->{is_end}) {
            # もうおわってた
            my $tap = $c->get_tap(@session_path);
            return $c->json_response({
                session => $session,
                path    => $current_path,
                tap     => $tap->as_hash,
            });
        } elsif ($current->{end_cv}) {
        } else {
            $current->{end_cv} = AE::cv;
            return sub {
                my $start_response = shift;
                $current->{end_cv}->cb(
                    sub {
                        shift->recv;
                        my $tap = $c->get_tap(@session_path);
                        $start_response->( $c->json_response({
                            session => $session,
                            path    => $current_path,
                            tap     => $tap->as_hash,
                        })->finalize );
                    }
                );
            }
        }
    }
}

sub pop_tap_request {
    my($c, $session, $req, $current_path) = @_;

    my $current = $c->get_path($session, $current_path);
    my $stack = $current->{ajax_request_stack} || +[];
    if (my $requests = $req->param('requests')) {
        if (scalar(@{ $stack }) >= $requests) {
            $stack = [ splice @{ $stack }, 0, $requests ];
        } else {
            # waiting
            if ($current->{pop_tap_request}) {
                # XXX error handling
                return Plack::Response->new( 500, [ 'Content-Type' => 'text/plain' ], 'over fllow pop_tap_request request' );
            }
            $current->{pop_tap_request} = {
                cv       => AE::cv,
                requests => $requests,
            };
            return sub {
                my $start_response = shift;
                $current->{pop_tap_request}->{cv}->cb(
                    sub {
                        my $tmp = delete $current->{pop_tap_request};
                        $start_response->( shift->recv->finalize );
                    }
                );
            }
        }
    } else {
        $current->{ajax_request_stack} = +[];
    }
    return $c->json_response($stack);
}

sub exit {
    my($c, $session, $req, $current_path) = @_;
    return unless $c->run_once && ref($c->{destroy}) eq 'CODE';
    my $tap = $c->get_tap($session, $current_path);
    $c->{destroy}->($c->{stdout}, $tap);
}

package JSTAPd::Server;
1;