File Coverage

blib/lib/Data/Lotter.pm

Criterion	Covered	Total	%
statement	73	73	100.0
branch	13	14	92.8
condition	7	8	87.5
subroutine	12	12	100.0
pod	4	4	100.0
total	109	111	98.2

package Data::Lotter;

use base qw( Class::Accessor::Fast );
use strict;
use warnings;
use Data::Dumper;
use constant DEBUG => $ENV{DATA_LOTTER_DEBUG};
use 5.8.1;

our $VERSION = '0.00004';

__PACKAGE__->mk_accessors(qw(lists available ));

*debug = DEBUG
  ? sub {
    my $mess = shift;
    print STDERR $mess, "\n";
  }
  : sub { };

sub new {
    my $class = shift;
    my %lists = @_;

    _scale_up(\%lists);

    my $cumulative = 0;
    foreach my $weight ( values %lists ) {
        $weight = int($weight);
        $cumulative += $weight;
    }

    return $class->SUPER::new( { available => $cumulative, lists => \%lists } );
}

sub _scale_up{
    my $lists_ref = shift;

    my ($i,$j);
    while ( my ( $key, $value ) = each %$lists_ref ) {
        $value =~ /\.(\d+)/;
        $1 and $i = length $1;
        if( !$j or $i > $j ){
            $j = $i;
        }
    }
    if($j){
        $j = 6 if $j > 6;
        my $scale = 10 ** $j;
        if($scale > 1){
            for(keys(%$lists_ref)){
                $lists_ref->{$_} *= $scale;
            }
        }
    }
}

sub pickup {
    my $self   = shift;
    my $num    = shift;
    my $remove = shift || '';
    my @ret;

    my $lists = $self->lists;
  OUTER:
    while ( $num-- ) {

        Dumper $lists;
        # mysterious hack
        # If there is not this, I can't pass the test code.

        my $n = int( rand( $self->available ) ) + 1;
        debug("-----------------------");
        debug("NUM: $num");
        debug("RANDOM: $n");
        debug( "BEFORE: " . Dumper($lists) );
        while ( my ( $item, $weight ) = each %$lists ) {
            if ( $weight > 0 && $weight >= $n ) {
                push @ret, $item;
                debug("HIT: $item");
                if ($remove) {
                    delete $lists->{$item};
                    $self->available( $self->available - $weight );
                }
                else {
                    $lists->{$item}--;
                    $self->available( $self->available - 1 );
                }
                debug( "AFTER: " . Dumper($lists) );
                next OUTER;
            }
            $n -= $weight;
        }
    }
    debug( "RETURN: " . join( ",", @ret ) );
    return @ret;
}

sub left_items {
    my $self  = shift;
    my @items = keys %{ $self->lists };
    return @items;
}

sub left_item_waits {
    my $self = shift;
    my $item = shift;
    return $self->lists->{$item};
}

1;

__END__