view release on metacpan or  search on metacpan

t/14_options.t  view on Meta::CPAN

    my %user_opt;

    my $user_options = '-range 1950-2000 -active ""';
    GetOptionsFromString($user_options, \%user_opt, @all_options);

    my ($opt_href, $opt_obj) = $opt->combine_options( \%user_opt );

    ok $opt_href->{range} eq '1950-2000', 'combine_options range';

    @errors = $opt->validate();
    ok !@errors, 'validate returned no errors';

    # uncoverable branch false
    if ($opt_href->{active}) {
        ok $opt_href->{active} eq $opt_href->{range}, 'active "" defaults to range';
    }
};

subtest 'country validation' => sub {
    my %user_opt;

    my $user_options = '-country CA';
    GetOptionsFromString($user_options, \%user_opt, @all_options);

    my ($opt_href, $opt_obj) = $opt->combine_options( \%user_opt );

    @errors = $opt->validate();
    ok !@errors, 'validate returned no errors';

    $user_options = '-country ZZ';
    GetOptionsFromString($user_options, \%user_opt, @all_options);

    ($opt_href, $opt_obj) = $opt->combine_options( \%user_opt );

    @errors = $opt->validate();
    ok @errors == 1, 'validate returned an error as expected';
    like $errors[0], qr{unrecognized}, 'unrecognized country code (GEC) search';

    $user_options = '-country Canada';
    GetOptionsFromString($user_options, \%user_opt, @all_options);

    ($opt_href, $opt_obj) = $opt->combine_options( \%user_opt );

    @errors = $opt->validate();
    ok !@errors, 'validate returned no errors';
};

subtest 'options_as_string' => sub {
    my %user_opt;

    my $user_options = '-location Ottawa -country CA -state ON -range 2000-2010 -gsn';
    GetOptionsFromString($user_options, \%user_opt, @all_options);

    my ($opt_href, $opt_obj) = $opt->combine_options( \%user_opt );
    # using the $profile_href obtained from the test yaml ealier
    @errors = $opt->validate();
    ok !@errors, 'validate returned no errors';

    my $opt_string = $opt->options_as_string;

    my @opt_list = split m{ \s\s }xms, $opt_string;

    $count = grep { $_ =~ m{ -baseline \s \d{4}-\d{4} }xms } @opt_list;
    is $count, 1, , '-baseline found';

    $count = grep { $_ =~ m{-kmlcolor \s red }xms } @opt_list;
    is $count, 1, , '-kmlcolor found';

    $count = grep { $_ =~ m{-country \s CA }xms } @opt_list;
    is $count, 1, , '-country found';

    $count = grep { $_ =~ m{ -location \s Ottawa }xms } @opt_list;
    is $count, 1, , '-location found';

    $count = grep { $_ =~ m{ -refresh \s (\w+|\d+) }xms } @opt_list;
    is $count, 1, , '-refresh found';

    $count = grep { $_ =~ m{ -quality \s \d+ }xms } @opt_list;
    is $count, 1, , '-quality found';

    $count = grep { $_ =~ m{ -radius \s \d+ }xms } @opt_list;
    is $count, 1, , '-radius found';

    $count = grep { $_ =~ m{ -range \s \d+[-]\d+ }xms } @opt_list;
    is $count, 1, , '-range found';

    $count = grep { $_ =~ m{ -state \s [[:alpha:]]{2} }xms } @opt_list;
    is $count, 1, , '-state found';

    my @r = grep { $_ =~ m{ -gsn }xms } @opt_list;
    is @r, 1, , "-gsn found (boolean option)";
    is $r[0], '-gsn', '-gsn formatted without a value';
};

subtest 'validate - values for range and active' => sub {

    my @valid_ranges = qw(
        1800-1899 1900-2099 1976-2000
    );

    my @invalid_ranges = qw(
        2000 10 69-83 12345-54321 zzz -1990 1700-1899
    );

    foreach my $testopt ('-range', '-active') {
        foreach my $r (@valid_ranges) {
            @errors = init_and_validate ($profile_href, $opt, "$testopt $r");
            ok !@errors, "validate good $testopt $r";
            # uncoverable branch true
            diag @errors if @errors;
        }
        note ''; # visual separation
    }

    foreach my $testopt ('-range', '-active') {
        foreach my $r (@invalid_ranges) {
            @errors = init_and_validate ($profile_href, $opt, "$testopt $r");
            # ok @errors, "testing $testopt $r - validate found errors";
            like $errors[0], qr/invalid/, "validate bad $testopt $r";
        }
        note ''; # visual separation