view release on metacpan or  search on metacpan

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

sub pick_one {
    my ($self) = @_;

    my $choice_score = 0;
    my $best_choice;
    for my $i (0 .. $#$self) {
        my ($in_use, $resource) = @{ $self->[$i] };

        next if $in_use;

        if ($choice_score < 5 and $i > 0 and $i < $#$self and not($self->[$i - 1][0]) and not($self->[$i + 1][0])) {
            $choice_score = 5;
            $best_choice = $i;
            last;
        }

        elsif ($choice_score < 4 and $i > 0 and not $self->[$i - 1][0]) {
            $choice_score = 4;
            $best_choice = $i;
        }

        elsif ($choice_score < 3 and $i < $#$self and not $self->[$i + 1][0]) {
            $choice_score = 3;
            $best_choice = $i;
        }

        elsif ($choice_score < 2 and $i > 0 and $i < $#$self) {
            $choice_score = 2;
            $best_choice = $i
        }

        elsif ($choice_score < 1) {
            $choice_score = 1;
            $best_choice = $i;
        }
    }

    if (defined $best_choice) {
        $self->[$best_choice][0] = 1;

        if (wantarray) {
            return ($best_choice, $self->[$best_choice][1], $choice_score);
        }
        else {
            return $best_choice;
        }
    }

    return;
}

=head2 pick

  my $resource = $self->pick($index);
  my ($resource, $comfort_level) = $self->pick($index);

Allows you to violate the usual algorithm to pick a urinal explicitly. In scalar
context it returns the resource picked. In list context, it returns that and the
comfort level your pick has. If the resource picked is already in use, an
exception will be thrown.

=cut

sub pick {
    my ($self, $i) = @_;

    if ($self->[$i][0]) {
        croak "The resource at index $i is already in use.";
    }

    if (wantarray) {
        my @r = $self->look($i);
        $self->[$i][0] = 1;
        return @r;
    }
    else {
        my $r = $self->look($i);
        $self->[$i][0] = 1;
        return $r;
    }
}

=head2 look

  my $resource = $self->look($index);
  my ($resource, $comfort_level) = $self->look($index);

In most algorithms, this would be called "peek," but peeking in urinals is, at
best, awkward and, at worst, likely to get you beat up.

This is the same as L</pick>, but does not actually allocate. Also, the
C<$comfort_level> returned will be C<0> if the resource is currently in use.

=cut

sub look {
    my ($self, $i) = @_;

    if (wantarray) {
        my $choice_score = 0;
        if (not $self->[$i][0]) {
            if ($i > 0 and $i < $#$self and not $self->[$i - 1][0] and not $self->[$i + 1][0]) {
                $choice_score = 5;
            }

            elsif ($i > 0 and not $self->[$i - 1][0]) {
                $choice_score = 4;
            }

            elsif ($i < $#$self and not $self->[$i + 1][0]) {
                $choice_score = 3;
            }

            elsif ($i > 0 and $i < $#$self) {
                $choice_score = 2;
            }

            else {
                $choice_score = 1;
            }