view release on metacpan or  search on metacpan

eg/rangelocks_perl.pl  view on Meta::CPAN

sub get_locks_for_number {
    my $number = shift;

    print "#\n";
    print "# getting meta lock\n";
    print "# trying to get locks for [$number]\n";
    our %locks;

    if ($locks{block_exact}{$number}) {    # EXC
        print "# exact number [$number] is blocked, aborting\n";
        print "# releasing meta lock\n";
        return;
    }

    local $_ = $number;
    my @substr;
    while (length()) {
        push @substr => $_;
        chop;
    }

    for my $substr (@substr) {
        if ($locks{block_range}{$substr}) {    # EXC
            print "# range [$substr] is blocked, aborting\n";
            print "# releasing meta lock\n";
            return;
        }
    }

    $locks{block_range}{$number}++;
    $locks{block_exact}{$_}++ for @substr;   # convert to SHARED

    print "# releasing meta lock\n";

eg/rangelocks_perl.pl  view on Meta::CPAN

sub test_not_ok_locks {
    my $number = shift;
    ok(!get_locks_for_number($number), "NOT OK get_locks_for_number($number)");
    dump_locks;
}


sub test_locks_are_empty {
    our %locks;
    is_deeply(($locks{block_exact} || {}), {}, 'no exact numbers are blocked');
    is_deeply(($locks{block_range} || {}), {}, 'no numbers ranges are blocked');
}


reset_locks();
test_ok_locks(431234);
test_not_ok_locks(431234);
test_not_ok_locks(4312);
test_not_ok_locks(4312345);
test_ok_locks(431235);
release_locks_for_number(431234);