view release on metacpan or  search on metacpan

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

  say $urinal->pick_one; # prints 4

  $urinal->leave(2);
  $urinal->leave(1);
  say $urinal->pick_one; # prints 1


=head1 DESCRIPTION

When men use a bathroom with multiple urinals. The way the urinal to use is
chosen is nearly deterministic. This module allocates resources in a way that
emulates this process.

Basically, a L<Acme::Urinal> object keeps track of a list of resources. You can
then request these resources be allocated and used by asking for one using the
L</pick_one> method. It will return the next resource according to the
algorithm. Once finished suing that resource, you may return it using the
L</leave> method.

Each resource is chosen according to the following rules:

=over

=item 1.

If possible, the lowest index resource that has a free resource on either side
is chosen.

=item 2.

Failing that, the lowest index resource with a lesser neighbor free is chosen.

=item 3.

Failing that, the lowest index resource with a greater neighbor free is chosen.

=item 4.

Failing that, the lowest index resource that is not at either end is chosen
(because those end ones usually tend to be the less preferable low urinal).

=item 5.

Finally, the lowest index resource that is available is chosen.

=back

=head1 METHODS

=head2 new

  my $urinal = Acme::Urinal->new($count);
  my $urinal = Acme::Urinal->new(\@resources);

Constructs a new Acme::Urinal object. If the argument is a positive integer, it
is the same as if an array reference were passed like this:

  [ 0 .. $count ]

If an array reference is passed, the object will use that array as the list of
resources. The array will be copied, so changes to the original, won't change
the one used by Acme::Urinal.

Anything else should cause an error.

=cut

sub new {
    my ($class, $resources) = @_;

    if (ref $resources) {
        return bless [ map { [ 0, $_ ] } @$resources ], $class;
    }
    elsif ($resources > 0) {
        return bless [ map { [ 0, $_ ] } 0 .. ($resources - 1) ], $class;
    }
    else {
        croak "incorrect argument";
    }
}

=head2 pick_one

  my $index = Acme::Urinal->pick_one;
  my ($index, $resource, $comfort_level) = Acme::Urinal->pick_one;

This will choose an available resource from those available using the algorithm
described in the L</DESCRIPTION>. If no resource is available, the return will
be C<undef> or an empty list.

In scalar context, the index of the resource is returned. In list context, a
three-element list is returned where the first element is the index, the second
is the resource that was allocated, and the third is the comfort level with
which the resource was allocated. The higher the level, the better the
allocation was (the earlier the rule from the L</DESCRIPTION> that was used to
make the allocation). Currently, the comfort level will be between 1 and 5.

=cut

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]) {