App-Base

 view release on metacpan or  search on metacpan

lib/App/Base/Script/Common.pm  view on Meta::CPAN

Whether the parsing encountered any errors

=back

=cut

sub _parse_arguments {
    my $self = shift;
    my $args = shift;

    local @ARGV = (@$args);

    # Build the hash of options to pass to Getopt::Long
    my $options      = $self->all_options;
    my %options_hash = ();
    my %getopt_args  = ();

    foreach my $option (@$options) {
        my $id   = $option->name;
        my $type = $option->option_type;
        if ($type eq 'string') {

t/common.t  view on Meta::CPAN

};

            local %ENV;
            $ENV{COLUMNS} = 100;
            $long_switches =~ s/\s+/ /g;
            is(trim($long_switches), trim($scswitches), 'COLUMNS environment variable controls width of switch table output');
        }

        HELP:
        {
            local @ARGV = ('--help');
            exits_ok(sub { Test::Script::Common->new; }, "--help forces exit");
        }

        NONSENSE:
        {
            local @ARGV = ('--nonsense-option');
            warnings_like {
                exits_ok(sub { Test::Script::Common->new; }, "Can't instantiate a script with an invalid option");
            }
            qr/Unknown option/, 'Unknown option warns';
        }

        INVALID_OPTION_VALUE:
        {
            local @ARGV = ('--quux=a_string');
            warnings_like {
                exits_ok(sub { Test::Script::Common->new; },
                    "Can't instantiate a script with an option value that does not match the specified type");
            }
            qr/invalid for option quux/, 'option with invalid type warns';
        }
    });

done_testing;

t/daemon.t  view on Meta::CPAN

    #wait pid to exit at most 5 seconds
    for (my $i = 0; $i <= 10; $i++) {
        last unless kill(0 => $pid);
        Time::HiRes::usleep(5e5);
    }
    ok !kill(0 => $pid), "Grandchild process has shut down";
}

NO_FORK:
{
    local @ARGV = ('--no-fork', '--no-pid-file');
    is(0, Test::Daemon::Exiting->new->run, '--no-fork runs and returns 0');
}

LE_ROI_SE_MEURT:
{
    my $pidfile = $pdir->child('Test::Daemon::Suicidal.pid');
    local $ENV{APP_BASE_DAEMON_PIDDIR} = $pdir;
    is(Test::Daemon::Suicidal->new->run, 0, 'Test::Suicidal daemon spawns detached child process');
    wait_file($pidfile);
    ok(-f $pidfile, "Suicidal pid file exists");

t/script.t  view on Meta::CPAN

$_ =~ s/\s+/ /g for @output_lines;
for (my $line = 0; $line < $#switch_lines; $line++) {
    is($switch_lines[$line], $output_lines[$line], "Switch output line " . ($line + 1) . " is correct");
}
is(0, $sc->run, 'Run returns 0');

divert_stderr(
    sub {
        HELP:
        {
            local @ARGV = ('--help');
            exits_ok(sub { Test::Script->new->run; }, "--help forces exit");
        }

        DEATH:
        {
            local @ARGV;
            warnings_like {
                exits_ok(sub { Test::Script::ThatDies->new->run; }, "die() in script causes exit");
            }
            [qr/^I die/], "Expected warning about his death";
        }

        ERROR:
        {
            warnings_like {
                exits_ok(

 view all matches for this distribution
 view release on metacpan -  search on metacpan