package threads;
use 5.008;
use strict;
use warnings;
our $VERSION = '1.82';
my $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
# Verify this Perl supports threads
require Config;
if (! $Config::Config{useithreads}) {
die("This Perl not built to support threads\n");
}
# Complain if 'threads' is loaded after 'threads::shared'
if ($threads::shared::threads_shared) {
warn <<'_MSG_';
Warning, threads::shared has already been loaded. To
enable shared variables, 'use threads' must be called
before threads::shared or any module that uses it.
_MSG_
}
# Declare that we have been loaded
$threads::threads = 1;
# Load the XS code
require XSLoader;
XSLoader::load('threads', $XS_VERSION);
### Export ###
sub import
{
my $class = shift; # Not used
# Exported subroutines
my @EXPORT = qw(async);
# Handle args
while (my $sym = shift) {
if ($sym =~ /^(?:stack|exit)/i) {
if (defined(my $arg = shift)) {
if ($sym =~ /^stack/i) {
threads->set_stack_size($arg);
} else {
$threads::thread_exit_only = $arg =~ /^thread/i;
}
} else {
require Carp;
Carp::croak("threads: Missing argument for option: $sym");
}
} elsif ($sym =~ /^str/i) {
import overload ('""' => \&tid);
} elsif ($sym =~ /^(?::all|yield)$/) {
push(@EXPORT, qw(yield));
} else {
require Carp;
Carp::croak("threads: Unknown import option: $sym");
}
}
# Export subroutine names
my $caller = caller();
foreach my $sym (@EXPORT) {
no strict 'refs';
*{$caller.'::'.$sym} = \&{$sym};
}
# Set stack size via environment variable
if (exists($ENV{'PERL5_ITHREADS_STACK_SIZE'})) {
threads->set_stack_size($ENV{'PERL5_ITHREADS_STACK_SIZE'});
}
}
### Methods, etc. ###
# Exit from a thread (only)
sub exit
{
my ($class, $status) = @_;
if (! defined($status)) {
$status = 0;
}
# Class method only
if (ref($class)) {
require Carp;
Carp::croak('Usage: threads->exit(status)');
}
$class->set_thread_exit_only(1);
CORE::exit($status);
}
# 'Constant' args for threads->list()
sub threads::all { }
sub threads::running { 1 }
sub threads::joinable { 0 }
# 'new' is an alias for 'create'
*new = \&create;
# 'async' is a function alias for the 'threads->create()' method
sub async (&;@)
{
unshift(@_, 'threads');
# Use "goto" trick to avoid pad problems from 5.8.1 (fixed in 5.8.2)
goto &create;
}
# Thread object equality checking
use overload (
'==' => \&equal,
'!=' => sub { ! equal(@_) },
'fallback' => 1
);
1;
__END__
=head1 NAME
threads - Perl interpreter-based threads
=head1 VERSION
This document describes threads version 1.82
=head1 SYNOPSIS
use threads ('yield',
'stack_size' => 64*4096,
'exit' => 'threads_only',
'stringify');
sub start_thread {
my @args = @_;
print('Thread started: ', join(' ', @args), "\n");
}
my $thr = threads->create('start_thread', 'argument');
$thr->join();
threads->create(sub { print("I am a thread\n"); })->join();
my $thr2 = async { foreach (@files) { ... } };
$thr2->join();
if (my $err = $thr2->error()) {
warn("Thread error: $err\n");
}
# Invoke thread in list context (implicit) so it can return a list
my ($thr) = threads->create(sub { return (qw/a b c/); });
# or specify list context explicitly
my $thr = threads->create({'context' => 'list'},
sub { return (qw/a b c/); });
my @results = $thr->join();
$thr->detach();
# Get a thread's object
$thr = threads->self();
$thr = threads->object($tid);
# Get a thread's ID
$tid = threads->tid();
$tid = $thr->tid();
$tid = "$thr";
# Give other threads a chance to run
threads->yield();
yield();
# Lists of non-detached threads
my @threads = threads->list();
my $thread_count = threads->list();
my @running = threads->list(threads::running);
my @joinable = threads->list(threads::joinable);
# Test thread objects
if ($thr1 == $thr2) {
...
}
# Manage thread stack size
$stack_size = threads->get_stack_size();
$old_size = threads->set_stack_size(32*4096);
# Create a thread with a specific context and stack size
my $thr = threads->create({ 'context' => 'list',
'stack_size' => 32*4096,
'exit' => 'thread_only' },
\&foo);
# Get thread's context
my $wantarray = $thr->wantarray();
# Check thread's state
if ($thr->is_running()) {
sleep(1);
}
if ($thr->is_joinable()) {
$thr->join();
}
# Send a signal to a thread
$thr->kill('SIGUSR1');
# Exit a thread
threads->exit();
=head1 DESCRIPTION
Since Perl 5.8, thread programming has been available using a model called
I which provides a new Perl interpreter for each
thread, and, by default, results in no data or state information being shared
between threads.
(Prior to Perl 5.8, I<5005threads> was available through the C API.
This threading model has been deprecated, and was removed as of Perl 5.10.0.)
As just mentioned, all variables are, by default, thread local. To use shared
variables, you need to also load L:
use threads;
use threads::shared;
When loading L, you must C