sub format_string {
    my ($str) = @_;
    return $str if ! $str;
    my $new_str = '';
    for my $chr (split '', $str) {
        my $ord = ord($chr);
        if ($ord < 255) {
            $new_str .= $chr;
            next;
        }
        $new_str .= '&#x' . sprintf("%x", $ord) . ';';
    }
    return $new_str;
}

##</code><code>##

my $wid = WaitWindow('Notepad', 5);

# Paranoia - make sure we are affecting the desired window
SetActiveWindow($wid);
SetFocus($wid);
SetForegroundWindow($wid);

# Used to determine where to move the mouse later 
my ($left, $top, $right, $bottom) = GetWindowRect($wid);

# Enable moving the mouse to move the window
# I *THINK* this will work

SendKeys("%{SPACE}M{DOWN}");

my ($x, $y) = calculate_position_from($left, $top, $right, $bottom);

MouseMoveAbsPix($x,$y);
SendKeys("{ENTER}");

##</code><code>##

## Shared the array of select ids
my @id :shared;

## Select them
while (my $rec = $sth->fetchrow_hashref) {
    push @id, $rec->{unique_id} if desired_rec($rec);
}

## Set the number of threads--start with 1 per core
our $T //= 4;

## break up the array into non-overlapping ranges
my( $step, $s, @ranges ) = ( int @id / $T, 0 );
push( @ranges, [ $s, $s + $step -1 ] ), $s += $step for 1 ..$T;
$ranges[ -1][1] = scalar @id;

my @threads;

## Loop over those ranges
for my $range ( @ranges ) {
    
    ##starting a new thread for each
    push @threads, async {
    
        ## Create a new handle in each thread
        my $dbh = DBI->connect( ... ) or die ..;
        
        my $del_sth = $dbh->prepare("DELETE FROM TBL WHERE unique_id = ?");

        ## process the subrange one at a time
        for( @id[ @$range ] ) {
            eval {
                $del_sth->execute($_);
            };
            $logger->write("Failed to remove '$_'") if $@;
        }
        ## till done
        $dbh->disconnect;
    };
}

## Wait for them
$_->join for @threads;

##</code><code>##

sub _insert {
    my ($node, $cmp, $key, $val) = @_;
    return [RED, $key, $val, undef, undef] if ! $node;

    # Do foo with $node

    my $result = $key cmp $node->[KEY];
    if ($result == EQUAL) {
        $node->[VALUE] = $val;
    }
    elsif ($result == MORE) {
        $node->[RIGHT] = _insert($node->[RIGHT], $cmp, $key, $val);
    }
    else {
        $node->[LEFT] = _insert($node->[LEFT], $cmp, $key, $val);
    }

    # Do bar with $node

    # Do blah with $node

    return $node;
}

##</code><code>##

sub _insert {
    my ($node, $cmp, $key, $val) = @_;

    my ($found, @stack);
    while ($node) {
        _colorFlip($node) if _isRed($node->[RIGHT]) && _isRed($node->[LEFT]); 
        push @stack, [$node, undef];

        my $result = $cmp->($key, $node->[KEY]);

        # Dup key, replace value
        if ($result == EQUAL) {
            ($found, $node->[VALUE]) = (1, $val);
            $node = undef;
        }

        # Descend right
        elsif ($result == MORE) {
            $stack[LAST][DIR] = RIGHT;
            $node = $node->[RIGHT];
        }

        # Descend right
        else {
            $stack[LAST][DIR] = LEFT;
            $node = $node->[LEFT];
        }
    }
    push @stack, [[RED, $key, $val, undef, undef], undef] if ! $found;

    my $assign;
    while (@stack) {
        my $unwind = pop @stack;
        my ($item, $dir) = @{$unwind}[NODE, DIR];
        if ($assign || $found) {
            $item->[$dir] = $assign->[NODE] if $assign;
            $item = _rotateLeft($item)  if _isRed($item->[RIGHT]) && ! _isRed($item->[LEFT]);
            $item = _rotateRight($item) if _isRed($item->[LEFT])  &&   _isRed($item->[LEFT][LEFT]);
        }
        $assign = [$item, undef];
    }
    return $assign->[NODE];
}

##</code><code>##

package Tree::Binary::RedBlack;
require Exporter;

@ISA    = 'Exporter';
@EXPORT = qw/
    deleteKey
    deleteMax
    deleteMin
    insert
    key_exists
    lookup
    max
    min
    new_rb
    node_count
/;

our $VERSION = '0.01';

# Tree definition
use constant ROOT    => 0;
use constant COUNT   => 1;
use constant COMPARE => 2;

# Node definition
use constant COLOR   => 0;
use constant KEY     => 1;
use constant VALUE   => 2;
use constant RIGHT   => 3;
use constant LEFT    => 4;

# Color definition
use constant BLACK   => 0;
use constant RED     => 1;

# Comparison definition
use constant LESS    => -1;
use constant EQUAL   => 0;
use constant MORE    => 1;

# Truth definition
use constant TRUE    => 1;
use constant FALSE   => undef;

# Stack definition
use constant LAST    => -1;
use constant NODE    => 0;
use constant DIR     => 1;

use strict;
use warnings;
use Carp;
use UNIVERSAL 'isa';

# Public 
sub new_rb {
    croak "Incorrect number of parameters" if @_ % 2;
    my %opt = @_;
    my $cmp = delete $opt{compare} || 'cmp';
    if (isa($cmp, 'CODE')) {
        *_insert = *_insert_custom;
    }
    elsif($cmp eq 'cmp') {
        #*_insert = *_insert_ascii;
        *_insert = *_insert_cmp;
    }
    else {
        croak "The '$cmp' comparison is not supported";
    }
    carp "The '$_' parameter is not supported\n" for keys %opt;
    return [undef, 0, $cmp];
}

# Public
sub insert {
    my ($tree, $key, $val) = @_;
    $tree->[ROOT] = _insert($tree->[ROOT], $tree->[COMPARE], $key, $val);
    $tree->[COUNT]++;
    $tree->[ROOT][COLOR] = BLACK;
}

# Private
sub _insert_custom {
    my ($node, $cmp, $key, $val) = @_;
    return [RED, $key, $val, undef, undef] if ! $node;

    if ($node->[RIGHT] && $node->[RIGHT][COLOR] && $node->[LEFT] && $node->[LEFT][COLOR]) {
        $node->[COLOR]        = ! $node->[COLOR]        || BLACK; 
        $node->[LEFT][COLOR]  = ! $node->[LEFT][COLOR]  || BLACK;
        $node->[RIGHT][COLOR] = ! $node->[RIGHT][COLOR] || BLACK;
    }

    my $result = $cmp->($key, $node->[KEY]);
    if ($result == EQUAL) {
        $node->[VALUE] = $val;
    }
    elsif ($result == MORE) {
        $node->[RIGHT] = _insert($node->[RIGHT], $cmp, $key, $val);
    }
    else {
        $node->[LEFT] = _insert($node->[LEFT], $cmp, $key, $val);
    }

    if ($node->[RIGHT] && $node->[RIGHT][COLOR] && ! ($node->[LEFT] && $node->[LEFT][COLOR])) {
        my $temp       = $node->[RIGHT];
        $node->[RIGHT] = $temp->[LEFT];
        $temp->[LEFT]  = $node;
        $temp->[COLOR] = $node->[COLOR];
        $node->[COLOR] = RED;
        $node          = $temp;
    }
    if ($node->[LEFT] && $node->[LEFT][COLOR] && $node->[LEFT][LEFT] && $node->[LEFT][LEFT][COLOR]) {
        my $temp       = $node->[LEFT];
        $node->[LEFT]  = $temp->[RIGHT];
        $temp->[RIGHT] = $node;
        $temp->[COLOR] = $node->[COLOR];
        $node->[COLOR] = RED;
        $node          = $temp;
    }
    return $node;
}

sub _insert_cmp {
    my ($node, $cmp, $key, $val) = @_;
    return [RED, $key, $val, undef, undef] if ! $node;

    if ($node->[RIGHT] && $node->[RIGHT][COLOR] && $node->[LEFT] && $node->[LEFT][COLOR]) {
        $node->[COLOR]        = ! $node->[COLOR]        || BLACK; 
        $node->[LEFT][COLOR]  = ! $node->[LEFT][COLOR]  || BLACK;
        $node->[RIGHT][COLOR] = ! $node->[RIGHT][COLOR] || BLACK;
    }

    my $result = $key cmp $node->[KEY];
    if ($result == EQUAL) {
        $node->[VALUE] = $val;
    }
    elsif ($result == MORE) {
        $node->[RIGHT] = _insert($node->[RIGHT], $cmp, $key, $val);
    }
    else {
        $node->[LEFT] = _insert($node->[LEFT], $cmp, $key, $val);
    }

    if ($node->[RIGHT] && $node->[RIGHT][COLOR] && ! ($node->[LEFT] && $node->[LEFT][COLOR])) {
        my $temp       = $node->[RIGHT];
        $node->[RIGHT] = $temp->[LEFT];
        $temp->[LEFT]  = $node;
        $temp->[COLOR] = $node->[COLOR];
        $node->[COLOR] = RED;
        $node          = $temp;
    }
    if ($node->[LEFT] && $node->[LEFT][COLOR] && $node->[LEFT][LEFT] && $node->[LEFT][LEFT][COLOR]) {
        my $temp       = $node->[LEFT];
        $node->[LEFT]  = $temp->[RIGHT];
        $temp->[RIGHT] = $node;
        $temp->[COLOR] = $node->[COLOR];
        $node->[COLOR] = RED;
        $node          = $temp;
    }

    return $node;
}

sub _insert_ascii {
    my ($node, $cmp, $key, $val) = @_;

    my ($found, @stack);
    while ($node) {
        if ($node->[RIGHT] && $node->[RIGHT][COLOR] && $node->[LEFT] && $node->[LEFT][COLOR]) {
            $node->[COLOR]        = ! $node->[COLOR]        || BLACK; 
            $node->[LEFT][COLOR]  = ! $node->[LEFT][COLOR]  || BLACK;
            $node->[RIGHT][COLOR] = ! $node->[RIGHT][COLOR] || BLACK;
        }
        my $result = $key cmp $node->[KEY];

        # Descend right
        if ($result == LESS) {
            push @stack, [$node, LEFT];
            $node = $node->[LEFT];
        }
        # Descend right
        elsif ($result == MORE) {
            push @stack, [$node, RIGHT];
            $node = $node->[RIGHT];
        }
        # Dup key, replace value
        else {
            push @stack, [$node];
            ($found, $node->[VALUE]) = (1, $val);
            $node = undef;
        }
    }
    push @stack, [[RED, $key, $val, undef, undef]] if ! $found;

    my $idx = @stack;
    my $assign;
    while ($idx--) {
        my ($item, $dir) = @{$stack[$idx]}[NODE, DIR];
        if ($assign || $found) {
            $item->[$dir] = $assign->[NODE] if $assign;

            if ($item->[RIGHT] && $item->[RIGHT][COLOR] && ! ($item->[LEFT] && $item->[LEFT][COLOR])) {
                my $temp       = $item->[RIGHT];
                $item->[RIGHT] = $temp->[LEFT];
                $temp->[LEFT]  = $item;
                $temp->[COLOR] = $item->[COLOR];
                $item->[COLOR] = RED;
                $item          = $temp;
            }

            if ($node->[LEFT] && $node->[LEFT][COLOR] && $node->[LEFT][LEFT] && $node->[LEFT][LEFT][COLOR]) {
                my $temp       = $node->[LEFT];
                $node->[LEFT]  = $temp->[RIGHT];
                $temp->[RIGHT] = $node;
                $temp->[COLOR] = $node->[COLOR];
                $node->[COLOR] = RED;
                $node          = $temp;
            }
        }
        $assign = [$item];
    }
    return $assign->[NODE];
}

sub lookup {
    my ($tree, $key) = @_;
    return FALSE if ! defined $key;
    my ($root, $cmp) = ($tree->[ROOT], $tree->[COMPARE]);
    while ($root) {
        my $result = $cmp->($key, $root->[KEY]);
        return $root->[VALUE] if $result == EQUAL;
        $root = $result == LESS ? $root->[LEFT] : $root->[RIGHT];
    }
    return FALSE;
}

sub key_exists {
    my ($tree, $key) = @_;
    return FALSE if ! defined $key;
    my ($root, $cmp) = ($tree->[ROOT], $tree->[COMPARE]);
    while ($root) {
        my $result = $cmp->($key, $root->[KEY]);
        return TRUE if $result == EQUAL;
        $root = $result == LESS ? $root->[LEFT] : $root->[RIGHT];
    }
    return FALSE;
}

sub node_count {
    my ($tree) = @_;
    return $tree->[COUNT];
}

sub deleteMin {
    my ($tree) = @_;
    $tree->[ROOT] = _deleteMin($tree->[ROOT]);
    $tree->[COUNT]-- if $tree->[COUNT];
    $tree->[ROOT][COLOR] = BLACK;
}

sub deleteKey {
    my ($tree, $key) = @_;
    $tree->[ROOT] = _deleteKey($tree->[ROOT], $tree->[COMPARE], $key);
    $tree->[COUNT]-- if $tree->[COUNT];
    $tree->[ROOT][COLOR] = BLACK;
}

sub max {
    my ($tree, $key) = @_;
    return FALSE if ! $tree->[ROOT];
    return _max($tree->[ROOT]);
}

sub min {
    my ($tree, $key) = @_;
    return FALSE if ! $tree->[ROOT];
    return _min($tree->[ROOT]);
}

sub deleteMax {
    my ($tree) = @_;
    $tree->[ROOT] = _deleteMax($tree->[ROOT]);
    $tree->[COUNT]-- if $tree->[COUNT];
    $tree->[ROOT][COLOR] = BLACK;
}

# Private

sub _deleteMax {
    my ($node) = @_;
    $node = _rotateRight($node) if _isRed($node->[LEFT]);
    return FALSE if ! $node->[RIGHT];
    $node = _moveRedRight($node) if ! _isRed($node->[RIGHT]) && ! _isRed($node->[RIGHT][LEFT]);
    $node->[RIGHT] = _deleteMax($node->[RIGHT]);
    return _fixUp($node);
}

sub _deleteKey {
    my ($node, $cmp, $key) = @_;
    if ($cmp->($key, $node->[KEY]) == LESS) {
        $node = _moveRedLeft($node) if ! _isRed($node->[LEFT]) && ! _isRed($node->[LEFT][LEFT]);
        $node->[LEFT] = _deleteKey($node->[LEFT], $cmp, $key);
    }
    else {
        $node = _rotateRight($node) if _isRed($node->[LEFT]);
        return FALSE if $cmp->($key, $node->[KEY]) == EQUAL && ! $node->[RIGHT];
        $node = _moveRedRight($node) if ! _isRed($node->[RIGHT]) && ! _isRed($node->[RIGHT][LEFT]);
        if ($cmp->($key, $node->[KEY]) == EQUAL) {
            # Opportunity to return key/val together
            $node->[VALUE] = _get($node->[RIGHT], $cmp, _min($node->[RIGHT]));
            $node->[KEY]   = _min($node->[RIGHT]);
            $node->[RIGHT] = _deleteMin($node->[RIGHT]);
        }
        else {
            $node->[RIGHT] = _deleteKey($node->[RIGHT], $key);
        }
    }
    return _fixUp($node);
}

sub _get {
    my ($node, $cmp, $key) = @_;
    return FALSE if ! $node;
    my $result = $cmp->($key, $node->[KEY]);
    return $node->[VALUE] if $result == EQUAL;
    return _get($node->[LEFT], $cmp, $key) if $result == LESS;
    return _get($node->[RIGHT], $cmp, $key);
}

sub _min {
    my ($node) = @_;
    return $node->[KEY] if ! $node->[LEFT];
    return _min($node->[LEFT]);
}

sub _max {
    my ($node) = @_;
    return $node->[KEY] if ! $node->[RIGHT];
    return _max($node->[RIGHT]);
}

sub _deleteMin {
    my ($node) = @_;
    return FALSE if ! $node->[LEFT];
    $node = _moveRedLeft($node) if ! _isRed($node->[LEFT]) && ! _isRed($node->[LEFT][LEFT]);
    $node->[LEFT] = _deleteMin($node->[LEFT]);
    return _fixUp($node);
}

sub _moveRedLeft {
    my ($node) = @_;
    _colorFlip($node);
    if (_isRed($node->[RIGHT][LEFT])) {
        $node->[RIGHT] = _rotateRight($node->[RIGHT]);
        $node = _rotateLeft($node);
        _colorFlip($node);
    }
    return $node;
}

sub _moveRedRight {
    my ($node) = @_;
    _colorFlip($node);
    if (_isRed($node->[LEFT][LEFT])) {
        $node = _rotateRight($node);
        _colorFlip($node);
    }
    return $node;
}


sub _rotateLeft {
    my ($node)     = @_;
    my $temp       = $node->[RIGHT];
    $node->[RIGHT] = $temp->[LEFT];
    $temp->[LEFT]  = $node;
    $temp->[COLOR] = $node->[COLOR];
    $node->[COLOR] = RED;
    return $temp;
}

sub _rotateRight {
    my ($node)     = @_;
    my $temp       = $node->[LEFT];
    $node->[LEFT]  = $temp->[RIGHT];
    $temp->[RIGHT] = $node;
    $temp->[COLOR] = $node->[COLOR];
    $node->[COLOR] = RED;
    return $temp;
}

sub _isRed {
    my ($node) = @_;
    return FALSE if ! $node;
    return $node->[COLOR] == RED;
}

sub _colorFlip {
    my ($node) = @_;
    $node->[COLOR]        = ! $node->[COLOR]        || BLACK; 
    $node->[LEFT][COLOR]  = ! $node->[LEFT][COLOR]  || BLACK;
    $node->[RIGHT][COLOR] = ! $node->[RIGHT][COLOR] || BLACK;
}

sub _fixUp {
    my ($node) = @_;
    $node = _rotateLeft($node)  if _isRed($node->[RIGHT]);
    $node = _rotateRight($node) if _isRed($node->[LEFT]) && _isRed($node->[LEFT][LEFT]);
    _colorFlip($node)           if _isRed($node->[LEFT]) && _isRed($node->[RIGHT]);
    return $node;
}

'This statement is false.';
__END__

OPTIMIZATIONS
1. Inline some subs
2. Turn recursion into a stack
3. Allow predefined comparison subs and then *foo = in order to not pay penalty
   - ascii, numerical, coderef sub {$_[0] cmp $_[1]}
4. Add get_min_kv and get_max_kv (see _deleteKey)
5. Turn the things that make sense from recursion to iteration (but frustratingly, not insert)
6. Consider XS
7. As a configurable option, allow not storing values to reduce memory



FEATURES
1. Add val_defined
2. Iterator for going over the tree

GENERAL
1. Consistency in sub names

REFERENCE
1. http://www.cs.princeton.edu/~rs/talks/LLRB/08Dagstuhl/RedBlack.pdf
2. http://www.cs.princeton.edu/~rs/talks/LLRB/RedBlack.pdf
3. http://www.cs.princeton.edu/~rs/talks/LLRB/08Penn.pdf


##</code><code>##

UPDATE
    table t
SET
    race_id = (
        SELECT
            pkey_id
        FROM
            race r,
            (SELECT * from race where pkey_id = t.race_id) x
        WHERE
            r.track_id = 41         AND
            r.raceday  = x.race_day AND
            r.race     = x.race
    )
WHERE
    race_id in (select pkey_id from race where track_id = 37)

##</code><code>##

table event
   pkey_id    = serial
   event_id   = integer
   event_date = date(YYYY-MM-DD)
   event_num  = integer

UPDATE
    event e
SET
    event_id = 41
WHERE
    event_id = 37 AND
    NOT EXISTS (
        SELECT
            1
        FROM
            event
        WHERE
            event_id   = 41           AND
            event_date = e.event_date AND
            event_num  = e.event_num
    ) 

##</code><code>##

print solve(
    holes => 33,
    empty => 17,
    towin => 17,
    valid => [
        [1, 2, 3],    [1, 4, 9],    [2, 5, 10],   [3, 6, 11],
        [4, 5, 6],    [4, 9, 16],   [5, 10, 17],  [6, 11, 18],
        [7, 8, 9],    [7, 14, 21],  [8, 9, 10],   [8, 15, 22],
        [9, 10, 11],  [9, 16, 23],  [10, 11, 12], [10, 17, 24],
        [11, 12, 13], [11, 18, 25], [12, 19, 26], [13, 20, 27],
        [14, 15, 16], [15, 16, 17], [16, 17, 18], [16, 23, 28],
        [17, 18, 19], [17, 24, 29], [18, 19, 20], [18, 25, 30],
        [21, 22, 23], [22, 23, 24], [23, 24, 25], [23, 28, 21],
        [24, 25, 26], [24, 29, 32], [25, 26, 27], [25, 30, 33],
        [28, 29, 30], [31, 32, 33],
    ],
);

##</code><code>##

#!/usr/bin/perl
use strict;
use warnings;

for my $base (3 .. 9) {
    print "\tBASE $base\n";
    my $next = count_base($base);
    my $n = 0;
    while (my @dig = $next->()) {
        my $num = join '', @dig;
        if (restricted(@dig)) {
            print "$n\n" if $n;
            $n = 0;
            #print "\t$num\n";
        }
        else {
            ++$n;
            #print "$num\n";
        }
    }
    print "\n\n";
}

sub restricted {
    my @dig = @_;
    my $i = 0;
    while (! $dig[$i]) {
        shift @dig;
    }
    for (1 .. $#dig) {
        return 0 if $dig[$_] <= $dig[$_ - 1];
    }
    return 1;
}

sub count_base {
    my $base = shift @_;
    my @dig = (0) x $base;
    my @end = 0 .. $base - 1;
    return sub {
        return () if "@dig" eq "@end";
        my $pos = @dig;
        while ($pos--) {
            if (++$dig[$pos] < $base) {
                @dig[$pos + 1 .. $#dig] = (0) x ($#dig - $pos);
                return @dig;
            }
        }
    };
}

##</code><code>##

#! /usr/bin/perl
use strict;
use warnings;
use Quantum::Superpositions;

my @array_1 = (1 .. 4);
my @array_2 = qw{1 2 2 3 3 3 4 4 4 4 7 6 5};

my @array_3 = eigenstates( any(@array_2) != all(@array_1) );
my @array_4 = Quantum::Superpositions::eigenstates( any(@array_2) != all(@array_1) );

print "Ordered:\n";
print "$_\n" for @array_3;
print "Hash:\n";
print "$_\n" for @array_4;

{
    no warnings 'redefine';
    *eigenstates = *main::eigenstates;
    sub eigenstates ($) {
        my @uniq;
        my %seen;
        for ( Quantum::Superpositions::collapse( $_[0] ) ) {
            push @uniq , $_ if ! $seen{$_};
            $seen{$_}++;
        }
        return @uniq;
    }
}

##</code><code>##

package Some::Object;
use strict;
use warnings;
use Carp;

our $VERSION = '0.01';

sub new {
    my $class = shift;
    my $self = bless {}, $class;
    croak "Incorrect number of parameters" if @_ % 2;
    $self->_init(@_);
    return $self;
}

sub _init {
    my $self = shift;
    my %default = (
        foo  => 'bar',
        blah => 'asdf',
    );
    my %user = @_;
    for ( keys %user ) {
        delete $user{$_} if ! exists $default{$_};
    }
    for ( keys %default ) {
        $user{$_} = $default{$_} if ! exists $user{$_};
    }
    $self->{OPT} = \%user;
}

##</code><code>##

#!/usr/bin/perl
use strict;
use warnings;
use Parallel::ForkManager;

use constant MAX_PROCS => 1;
use constant MAX_TIME  => 10;

my ($pid, $ident, $start);
my $pm = new Parallel::ForkManager( MAX_PROCS );

@SIG{ qw(ABRT STOP TERM INT) } = (sub { kill 9, $pid; exit }) x 4;

$pm->run_on_start (
    sub {
        ($pid, $ident)= @_;
        $start = time;
        print "$ident started at ", scalar localtime($start), " with pid: $pid\n";
    }
);

$pm->run_on_wait (
    sub {
        if ( time - $start > MAX_TIME ) {
            print "Killing $pid - taking too long to run\n";
            kill 9, $pid;
        }
    },
    1
);

$pm->run_on_finish (
    sub {
        ($pid, my $exit_code, $ident) = @_;
        print "$ident ($pid) just completed with : $exit_code\n";
    }
);

while ( 1 ) {
    $pid = $pm->start( 'health check' ) and next;

    # We are in child  process
    for ( 1 .. rand 15 ) {
        print "I am the child doing work\n";
        sleep 1;

    }

    $pm->finish;
    # We are in parent process
}