view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.

                     END OF TERMS AND CONDITIONS

        Appendix: How to Apply These Terms to Your New Programs

  If you develop a new program, and you want it to be of the greatest
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.

  To do so, attach the following notices to the program.  It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.

    <one line to give the program's name and a brief idea of what it does.>
    Copyright (C) 19yy  <name of author>

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

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

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

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