view release on metacpan or  search on metacpan

lib/Acme/Dice.pm  view on Meta::CPAN

        )
    );

    return wantarray ? @rolls : $rolls[0] + $rolls[1];
}

sub _validate_params {
    my $raw_args = @_ == 1 ? shift : {@_};

    my $args = {};
    my @errors;

    # put put defaults in place for missing params
    # and detect incoming undefined params
    for ( keys( %{$defaults} ) ) {
        $raw_args->{$_} = $defaults->{$_} if !exists( $raw_args->{$_} );
        push( @errors, "param present but undefined: $_" )
          unless defined $raw_args->{$_};
        $args->{$_} = delete( $raw_args->{$_} );
        push( @errors, "$_ must be a non-negative integer: $args->{$_}" )
          if defined( $args->{$_} ) && $args->{$_} !~ m/^\d+$/;
    }
    push( @errors,
        'RTFM! Unknown params: ' . join( ', ', keys( %{$raw_args} ) ) )
      if keys( %{$raw_args} );

    croak join( "\n", @errors ) if @errors;

    # validate individual params now
    push( @errors, "Illegal value for 'dice': $args->{dice}" )
      if $args->{dice} < 1;
    push( @errors, "Really? Roll $args->{dice} dice?" ) if $args->{dice} > 100;

    push( @errors, "Illegal value for 'sides': $args->{sides}" )
      if $args->{sides} < 1;

    push( @errors, "Illegal value for 'favor': $args->{favor}" )
      if $args->{favor} < 0 || $args->{favor} > $args->{sides};
    push( @errors, "Illegal value for 'bias': $args->{bias}" )
      if $args->{bias} < 0 || $args->{bias} > 100;

    croak join( "\n", @errors ) if @errors;

    return $args;
}

sub _apply_bias {
    my $roll_src = shift;
    my $args     = shift;

    ${$roll_src} = $args->{favor}
      if ${$roll_src} != $args->{favor} && rand(100) < $args->{bias};

t/10_roll_dice.t  view on Meta::CPAN

    my @rolls = roll_dice();
    ok( @rolls == 1, 'default roll has one die' );
    ok( $rolls[0] >= 1 && $rolls[0] <= 6, 'default consistent with a d6' );

    # check if undefined parameters are caught
    for (qw(dice sides favor bias)) {
        my $roll = eval { roll_dice( $_ => undef ); };
        ok( !defined($roll), "dies with undefined param: $_" );
    }

    # and be sure unknown params throw an error
    my $roll_u = eval { roll_dice( foo => 'bar' ); };
    ok( !defined($roll_u), 'dies with unknown parameter' );
};

subtest 'dice parameter values' => sub {
    plan tests => 15;

    for ( 1, 2, 3, 5, 100 ) {
        my $roll = roll_dice( dice => $_, sides => 1 );
        ok( $roll == $_, "good dice param: $_" );

t/20_roll_craps.t  view on Meta::CPAN

    ok( @rolls == 2, 'default roll has two die' );
    ok( $rolls[0] >= 1 && $rolls[0] <= 6, 'default consistent with a d6' );
    ok( $rolls[1] >= 1 && $rolls[1] <= 6, 'default consistent with a d6' );

    # check if unknown parameters are caught
    for (qw(dice sides favor foo)) {
        my $roll = eval { roll_craps( $_ => undef ); };
        ok( !defined($roll), "dies with unknown param: $_" );
    }

    # and be sure an undefined param throws an error
    my $roll_u = eval { roll_craps( bias => undef ); };
    ok( !defined($roll_u), 'dies with undefined bias parameter' );
};

subtest 'bias parameter values' => sub {
    plan tests => 2;

    for ( -1, 101 ) {
        my $roll = eval { roll_craps( bias => $_ ); };
        ok( !defined($roll), "dies with bad bias param: $_" );