view release on metacpan or  search on metacpan

t/aggregate/unit_core_script_server.t  view on Meta::CPAN

sub testOption {
    my ($argstring, $resultarray) = @_;
    my $app = _build_testapp($argstring);
    try {
        $app->run;
    }
    catch {
        fail $_;
    };
    # First element of RUN_ARGS will be the script name, which we don't care about

    shift @TestAppToTestScripts::RUN_ARGS;
    my $server = pop @TestAppToTestScripts::RUN_ARGS;
    like ref($server), qr/^Plack::Handler/, 'Is a Plack::Handler';

    my @run_args =  @TestAppToTestScripts::RUN_ARGS;
    $run_args[-1]->{pidfile} = $run_args[-1]->{pidfile}->file->stringify
      if scalar(@run_args) && $run_args[-1]->{pidfile};

    # Mangle argv into the options..
    $resultarray->[-1]->{argv} = $argstring;
    $resultarray->[-1]->{extra_argv} = [];
    is_deeply \@run_args, $resultarray, "is_deeply comparison " . join(' ', @$argstring);
}

sub testBackgroundOptionWithFork {
    my ($argstring) = @_;

    ## First, make sure we can get an app
    my $app = _build_testapp($argstring);

    ## Sorry, don't really fork since this cause trouble in Test::Aggregate
    $app->meta->add_around_method_modifier('daemon_fork', sub { return; });

    try {
        $app->run;
    }
    catch {
        fail $_;
    };

    ## Check a few args
    is_deeply $app->{ARGV}, $argstring;
    is $app->port, '3000';
    is($app->{background}, 1);
}

sub testRestart {
    my ($argstring, $resultarray) = @_;
    my $app = _build_testapp($argstring);
    ok $app->restart, 'App is in restart mode';
    my $args = {$app->_restarter_args};
    is_deeply delete $args->{argv}, $argstring, 'argv is arg string';
    is ref(delete $args->{start_sub}), 'CODE', 'Closure to start app present';
    is_deeply $args, $resultarray, "is_deeply comparison of restarter args " . join(' ', @$argstring);
}

sub _build_testapp {
    my ($argstring, $resultarray) = @_;

    local @ARGV = @$argstring;
    local @TestAppToTestScripts::RUN_ARGS;
    my $i;
    try {
        $i = Catalyst::Script::Server->new_with_options(application_name => 'TestAppToTestScripts');
        pass "new_with_options " . join(' ', @$argstring);
    }
    catch {
        fail "new_with_options " . join(' ', @$argstring) . " " . $_;
    };
    ok $i;
    return $i;
}

# Returns the hash expected when no flags are passed
sub opthash {
    return {
        'pidfile' => undef,
        'fork' => 0,
        'follow_symlinks' => 0,
        'background' => 0,
        'keepalive' => 0,
        port => 3000,
        host => undef,
        @_,
    };
}

sub restartopthash {
    my $opthash = opthash(@_);
    my $val = {
        application_name => 'TestAppToTestScripts',
        port => '3000',
        debug => undef,
        host => undef,
        %$opthash,
    };
    return $val;
}

chdir($cwd);

1;