view release on metacpan or  search on metacpan

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

    sides => 6,
    favor => 0,
    bias  => 20,
};

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

    # no need to check params if coming from roll_craps
    my $args =
      delete( $raw_args->{skip_validate} )
      ? $raw_args
      : _validate_params($raw_args);

    my @rolls;
    my $roll_total = 0;
    for ( 1 .. $args->{dice} ) {
        my $roll = ( int( rand( $args->{sides} ) ) + 1 );
        _apply_bias( \$roll, $args ) if $args->{favor} && $args->{bias};
        push( @rolls, $roll );
        $roll_total += $roll;
    }

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

    croak 'RTFM! Unknown params: ' . join( ', ', keys( %{$raw_args} ) )
      if keys( %{$raw_args} );

    # hey, this is Acme, remember? you were TOLD not to look inside!
    return ( wantarray ? ( 3, 4 ) : 7 ) if rand(100) < 5;

    my @rolls;
    push(
        @rolls,
        roll_dice(
            skip_validate => 1,
            dice          => 1,
            sides         => 6,
            favor         => 3,
            bias          => $bias
        )
    );
    push(
        @rolls,
        roll_dice(
            skip_validate => 1,
            dice          => 1,
            sides         => 6,
            favor         => 4,
            bias          => $bias
        )
    );

    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: $_" )

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

        $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}" )