view release on metacpan or  search on metacpan

lib/JSTAPd/Suite.pm  view on Meta::CPAN

package JSTAPd::Suite;
use strict;
use warnings;
use FindBin;
use Path::Class ();
use Test::TCP ();

use JSTAPd::Server;

sub import {
    my $class    = shift;
    my $caller   = caller;

    my $in_the_parse = do {
        no strict 'refs';
        ${"$caller\::IN_THE_PARSE"};
    };

    strict->import;
    warnings->import;
    if ($in_the_parse) {
        return;
    }

    my $suite_file = Path::Class::File->new((caller)[1]);
    my $base_dir   = detect_root($suite_file->dir);
    run_server($suite_file, $base_dir);
}

sub detect_root {
    my $path = shift;
    while (!-f $path->file('conf.pl')) {
        die 'can not detect conf.pl' if $path eq $path->parent;
        $path = $path->parent;
    }
    $path;
}

sub run_server {
    my($suite_file, $dir) = @_;
    my $port = $ENV{JSTAP_PORT} || Test::TCP::empty_port();

    JSTAPd::Server->new(
        dir      => $dir,
        ($ENV{JSTAP_HOST} ? (host => $ENV{JSTAP_HOST}) : ()),
        port     => $port,
        run_file => $suite_file->relative($dir),
        destroy  => \&show_tap,
    )->run;
}

sub show_tap {
    my($stdout, $tap) = @_;
    print $stdout $tap->as_string;
    exit;
}

sub _load_split_files {
    my($class, $method, $ext) = @_;
    return if $class->can($method);

    my $file = do {
        $class->can('path') && $class->path;
    } || $0;
    $file =~ s/\.t$/.$ext/;
    return unless -f $file;
    no strict 'refs';
    *{"$class\::$method"} = sub {
        open my $fh, '<', $file or die "$file: $!";
        local $/;
        <$fh>;
    };
}

sub export {
    my $class = shift;

    do {
        no strict 'refs';