+our $VERSION = '2.03';
+
+use threads::shared 0.96;
+use Scalar::Util 1.10 qw(looks_like_number);
+
+# Predeclarations for internal functions
+my ($make_shared, $validate_count, $validate_index);
+
+# Create a new queue possibly pre-populated with items
+sub new
+{
+ my $class = shift;
+ my @queue :shared = map { $make_shared->($_) } @_;
+ return bless(\@queue, $class);
+}
+
+# Add items to the tail of a queue
+sub enqueue
+{
+ my $queue = shift;
+ lock(@$queue);
+ push(@$queue, map { $make_shared->($_) } @_)
+ and cond_signal(@$queue);
+}
+
+# Return a count of the number of items on a queue
+sub pending
+{
+ my $queue = shift;
+ lock(@$queue);
+ return scalar(@$queue);
+}
+
+# Return 1 or more items from the head of a queue, blocking if needed
+sub dequeue
+{
+ my $queue = shift;
+ lock(@$queue);
+
+ my $count = @_ ? $validate_count->(shift) : 1;
+
+ # Wait for requisite number of items
+ cond_wait(@$queue) until (@$queue >= $count);
+ cond_signal(@$queue) if (@$queue > $count);
+
+ # Return single item
+ return shift(@$queue) if ($count == 1);
+
+ # Return multiple items
+ my @items;
+ push(@items, shift(@$queue)) for (1..$count);
+ return @items;
+}
+
+# Return items from the head of a queue with no blocking
+sub dequeue_nb
+{
+ my $queue = shift;
+ lock(@$queue);
+
+ my $count = @_ ? $validate_count->(shift) : 1;
+
+ # Return single item
+ return shift(@$queue) if ($count == 1);
+
+ # Return multiple items
+ my @items;
+ for (1..$count) {
+ last if (! @$queue);
+ push(@items, shift(@$queue));
+ }
+ return @items;
+}
+
+# Return an item without removing it from a queue
+sub peek
+{
+ my $queue = shift;
+ lock(@$queue);
+ my $index = @_ ? $validate_index->(shift) : 0;
+ return $$queue[$index];
+}
+
+# Insert items anywhere into a queue
+sub insert
+{
+ my $queue = shift;
+ lock(@$queue);
+
+ my $index = $validate_index->(shift);
+
+ return if (! @_); # Nothing to insert
+
+ # Support negative indices
+ if ($index < 0) {
+ $index += @$queue;
+ if ($index < 0) {
+ $index = 0;
+ }
+ }
+
+ # Dequeue items from $index onward
+ my @tmp;
+ while (@$queue > $index) {
+ unshift(@tmp, pop(@$queue))
+ }
+
+ # Add new items to the queue
+ push(@$queue, map { $make_shared->($_) } @_);
+
+ # Add previous items back onto the queue
+ push(@$queue, @tmp);
+
+ # Soup's up
+ cond_signal(@$queue);
+}
+
+# Remove items from anywhere in a queue
+sub extract
+{
+ my $queue = shift;
+ lock(@$queue);
+
+ my $index = @_ ? $validate_index->(shift) : 0;
+ my $count = @_ ? $validate_count->(shift) : 1;
+
+ # Support negative indices
+ if ($index < 0) {
+ $index += @$queue;
+ if ($index < 0) {
+ $count += $index;
+ return if ($count <= 0); # Beyond the head of the queue
+ return $queue->dequeue_nb($count); # Extract from the head
+ }
+ }
+
+ # Dequeue items from $index+$count onward
+ my @tmp;
+ while (@$queue > ($index+$count)) {
+ unshift(@tmp, pop(@$queue))
+ }
+
+ # Extract desired items
+ my @items;
+ unshift(@items, pop(@$queue)) while (@$queue > $index);
+
+ # Add back any removed items
+ push(@$queue, @tmp);
+
+ # Return single item
+ return $items[0] if ($count == 1);
+
+ # Return multiple items
+ return @items;
+}
+
+### Internal Functions ###
+
+# Create a thread-shared version of a complex data structure or object
+$make_shared = sub {
+ my $item = shift;
+
+ # If already thread-shared, then just return the input item
+ return $item if (threads::shared::is_shared($item));
+
+ # Make copies of array, hash and scalar refs
+ my $copy;
+ if (my $ref_type = Scalar::Util::reftype($item)) {
+ # Copy an array ref
+ if ($ref_type eq 'ARRAY') {
+ # Make empty shared array ref
+ $copy = &share([]);
+ # Recursively copy and add contents
+ push(@$copy, map { $make_shared->($_) } @$item);
+ }
+
+ # Copy a hash ref
+ elsif ($ref_type eq 'HASH') {
+ # Make empty shared hash ref
+ $copy = &share({});
+ # Recursively copy and add contents
+ foreach my $key (keys(%{$item})) {
+ $copy->{$key} = $make_shared->($item->{$key});
+ }
+ }
+
+ # Copy a scalar ref
+ elsif ($ref_type eq 'SCALAR') {
+ $copy = \do{ my $scalar = $$item; };
+ share($copy);
+ # Clone READONLY flag
+ if (Internals::SvREADONLY($$item)) {
+ Internals::SvREADONLY($$copy, 1);
+ }
+ }
+
+ # Copy of a ref of a ref
+ elsif ($ref_type eq 'REF') {
+ my $tmp = $make_shared->($$item);
+ $copy = \$tmp;
+ share($copy);
+ }
+ }
+
+ # If no copy is created above, then just return the input item
+ # NOTE: This will end up generating an error for anything
+ # other than an ordinary scalar
+ return $item if (! defined($copy));
+
+ # Clone READONLY flag
+ if (Internals::SvREADONLY($item)) {
+ Internals::SvREADONLY($copy, 1);
+ }
+
+ # If input item is an object, then bless the copy into the same class
+ if (my $class = Scalar::Util::blessed($item)) {
+ bless($copy, $class);
+ }
+
+ return $copy;
+};
+
+# Check value of the requested index
+$validate_index = sub {
+ my $index = shift;
+
+ if (! looks_like_number($index) || (int($index) != $index)) {
+ require Carp;
+ my ($method) = (caller(1))[3];
+ $method =~ s/Thread::Queue:://;
+ $index = 'undef' if (! defined($index));
+ Carp::croak("Invalid 'index' argument ($index) to '$method' method");
+ }
+
+ return $index;
+};
+
+# Check value of the requested count
+$validate_count = sub {
+ my $count = shift;
+
+ if ((! looks_like_number($count)) || (int($count) != $count) || ($count < 1)) {
+ require Carp;
+ my ($method) = (caller(1))[3];
+ $method =~ s/Thread::Queue:://;
+ $count = 'undef' if (! defined($count));
+ Carp::croak("Invalid 'count' argument ($count) to '$method' method");
+ }
+
+ return $count;
+};
+
+1;