巫师不敢涉足之地
Perl 5.8的一个重大新特性是，我们现在可以通过threads pragma获得真正可用的线程。
然而，对于我们这些必须在不同版本的Perl和不同平台上支持我们模块的模块作者来说，我们现在又得处理另一个案例：线程！这篇文章将向您展示线程如何与模块相关，我们将如何将旧模块转换为线程安全，并以一个改变Perl“当前工作目录”行为的模块结束。
要运行我这里展示的示例，您需要Perl 5.8 RC1或更高版本，并使用线程编译。在Unix上，您可以使用Configure -Duseithreads -Dusethreads；在Win32上，默认构建始终启用线程。
线程与模块有何关系？
Perl中的线程基于显式共享数据的概念。也就是说，只有被明确请求共享的数据才会在线程之间共享。这是由threads::shared pragma和“: shared”属性控制的。看看它是如何工作的
use threads;
my $var = 1;
threads->create(sub { $var++ })->join();
print $var;
如果您习惯了大多数其他语言（Java/C）中的线程，您会期望$var包含一个2，并且这个脚本的输出结果是“2”。然而，由于Perl不在线程之间共享数据，$var被复制到线程中，并且只在该线程中增加。主线程中的原始值未改变，因此输出是“1”。
然而，如果我们添加threads::shared和: shared属性，我们就可以得到期望的结果
use threads;
use threads::shared;
my $var : shared = 1;
threads->create(sub { $var++ })->join();
print $var
现在结果将是“2”，因为我们声明$var为一个共享变量。Perl将操作同一变量，并提供自动锁定以保持变量不会出问题。
这使得我们模块开发者确保我们的模块是线程安全的变得更加简单。基本上，所有纯Perl模块都是线程安全的，因为任何全局状态数据（通常会给您带来线程安全问题的数据），默认情况下是每个线程本地的。
线程安全级别的定义
为了定义我们所说的线程安全，这里有一些从Solaris线程安全级别中借鉴的术语。
线程安全
这个模块可以安全地由多个线程使用。调用安全模块的效果是，当由多个线程调用时，结果仍然是有效的。然而，线程安全模块仍然可能具有全局影响；例如，从套接字发送或读取数据会影响所有正在使用该套接字的线程。应用程序有责任在处理线程时表现得理智。如果一个线程创建了一个名为file.tmp的文件，那么另一个尝试创建该文件的文件将失败；这不是模块的错。
线程友好
线程友好的模块是线程安全的模块，它们了解并提供专门用于处理线程的函数，或者自己使用线程。一个典型的例子是核心的threads::queue模块。人们也可以想象一个具有缓存的线程友好模块，它将缓存声明为线程间共享，以提高命中率并节省内存。
线程不安全
这个模块不能安全地从不同的线程使用；它取决于应用程序来同步对库的访问，并确保它能按照指定的方式工作。这里的典型例子是使用外部不安全库的XS模块，这些库可能只允许一个线程执行。
由于Perl只有在被请求时才会共享，大多数纯Perl代码可能属于线程安全类别，但这并不意味着你应该在没有审查源代码或作者已将其标记为线程安全的情况下信任它。典型问题包括使用alarm()，与信号杂乱无章地操作，使用相对路径以及依赖于%ENV。然而，请记住，所有未声明任何内容的XS模块都归入明确的线程不安全类别。
为什么我要费心使我的模块线程安全或线程友好呢？
嗯，这通常不会花费太多精力，这将使那些希望在使用线程环境中的模块的用户非常高兴。什么？你说线程化的Perl环境并不常见？等到Apache 2.0和mod_perl 2.0可用。一个重大变化是，Apache 2.0可以以线程模式运行，然后mod_perl也必须以线程模式运行；这可以在某些操作系统上带来巨大的性能提升。所以，如果你想使你的模块与mod_perl 2.0一起工作，查看线程安全级别是个不错的选择。
那么，我该怎么做才能使我的模块线程友好呢？
一个需要稍作修改才能与线程一起工作的模块的例子是Michael Schwern最出色的Test::Simple套件（Test::Simple，Test::More和Test::Builder）。令人惊讶的是，我们不得不做很少的改变来修复它。
问题是测试编号在线程之间没有共享。
例如
use threads;
use Test::Simple tests => 3;
ok(1);
threads->create(sub { ok(1) })->join();
ok(1);
现在这将返回
1..3
ok 1
ok 2
ok 2
这看起来像我们之前遇到的问题吗？确实如此，好像某个地方有一个需要共享的变量。
现在阅读Test::Simple的文档，我们发现所有魔法实际上都是在Test::Builder中完成的，打开Builder.pm，我们很快找到以下代码行
my @Test_Results = ();
my @Test_Details = ();
my $Curr_Test = 0;
现在我们可能会倾向于添加use threads::shared和:shared属性。
use threads::shared;
my @Test_Results : shared = ();
my @Test_Details : shared = ();
my $Curr_Test : shared = 0;
然而，Test::Builder需要回退到Perl 5.4.4！属性是在5.6.0中添加的，上述代码在早期的Perl中将是语法错误。即使有人使用5.6.0，threads::shared对他们来说也不会可用。
解决方案是使用由threads::shared导出的运行时函数share()，但我们只想在5.8.0及更高版本且线程已启用时这么做。所以，让我们将其包裹在一个BEGIN块和一个if中。
BEGIN{
if($] >= 5.008 && exists($INC{'threads.pm'})) {
require threads::shared;
import threads::shared qw(share);
share($Curr_Test);
share(@Test_Details)
share(@Test_Results);
}
因此，如果5.8.0或更高版本，并且线程已加载，我们就执行use threads::shared qw(share);的运行时等效操作，并调用我们想要共享的变量上的share()。
现在让我们找出一些使用$Curr_Test的例子。我们在Test::Builder中找到sub ok {}；我不会在这里包括它，但只包括一个包含以下内容的较小版本：
sub ok {
my($self, $test, $name) = @_;
$Curr_Test++;
$Test_Results[$Curr_Test-1] = 1 unless($test);
}
现在，这看起来应该工作得很正常？我们已经共享了$Curr_Test和@Test_Results。当然，事情并不那么简单；它们永远都不会那么简单。即使变量是共享的，两个线程也可能同时进入ok()。记住，即使是$CurrTest++这样的语句也不是原子操作，它只是写入$CurrTest = $CurrTest + 1的快捷方式。所以，假设两个线程同时这么做。
Thread 1: add 1 + $Curr_Test
Thread 2: add 1 + $Curr_Test
Thread 2: Assign result to $Curr_Test
Thread 1: Assign result to $Curr_Test
结果将是$Curr_Test只会增加一次，而不是两次！记住，线程之间的切换可以在任何时间发生，如果你在多CPU机器上，它们可以同时运行！永远不要相信线程惯性。
那么我们如何解决这个问题呢？我们使用lock()关键字。lock()接受一个共享变量并锁定它，直到作用域的其余部分，但它只是一个建议性锁定，因此我们需要找到$Curr_Test被使用和修改的每个地方，并且预计它不会改变。《ok()`变为
sub ok {
my($self, $test, $name) = @_;
lock($Curr_Test);
$Curr_Test++;
$Test_Results[$Curr_Test-1] = 1 unless($test);
}
那么我们准备好了吗？嗯，lock()是在Perl 5.5中添加的，所以我们需要在BEGIN子句中添加一个else来定义一个锁定函数，如果我们不是在带线程的环境中运行。最终结果是。
my @Test_Results = ();
my @Test_Details = ();
my $Curr_Test = 0;
BEGIN{
if($] >= 5.008 && exists($INC{'threads.pm'})) {
require threads::shared;
import threads::shared qw(share);
share($Curr_Test);
share(@Test_Details)
share(@Test_Results);
} else {
*lock = sub(*) {};
}
}
sub ok {
my($self, $test, $name) = @_;
lock($Curr_Test);
$Curr_Test++;
$Test_Results[$Curr_Test-1] = 1 unless($test);
}
事实上，这与为使Test::Builder与线程协同工作而添加的代码非常相似。唯一不正确的地方是ok()，因为我将其简化到相关部分。大约有5处需要添加lock()。现在测试代码将打印：
1..3
ok 1
ok 2
ok 3
这正好是最终用户所期望的。总的来说，这对于1291行模块来说是一个相当小的改动，我们以非侵入性的方式更改了大约15行，文档和测试用例代码构成了补丁的大部分。完整的补丁在这里。
修改Perl的行为以使其线程安全，ex::threads::cwd
使用线程时，某些事情会发生变化；一些你或模块可能做的事情与过去不同。大多数变化将归因于你的操作系统如何处理使用线程的进程。每个进程通常有一组属性，包括当前工作目录、环境表、信号子系统和pid。由于线程是单个进程内的多个执行路径，操作系统将其视为单个进程，并且你有一组这些属性。
是的，没错——如果你在一个线程中更改当前工作目录，它也会更改所有其他线程的工作目录！哎呀，最好在所有地方都使用绝对路径，以及所有可能使用相对路径的代码。
不用担心，这是一个可以解决的问题。实际上，这个问题可以通过一个模块来解决。
Perl允许我们使用CORE::GLOBAL命名空间覆盖函数。这将使我们能够覆盖处理路径的函数，并在执行命令之前正确地设置cwd。所以让我们从以下开始
package ex::threads::safecwd;
use 5.008;
use strict;
use warnings;
use threads::shared;
our $VERSION = '0.01';
这里没有奇怪的地方，对吧？现在，在更改和处理当前工作目录时，人们通常使用Cwd模块，因此让我们首先使cwd模块安全。我们如何做到这一点？
1) use Cwd;
2) our $cwd = cwd; #our per thread cwd, init on startup from cwd
3) our $cwd_mutex : shared; # the variable we use to sync
4) our $Cwd_cwd = \&Cwd::cwd;
5) *Cwd::cwd = *my_cwd;
sub my_cwd {
6) lock($cwd_mutex);
7) CORE::chdir($cwd);
8) $Cwd_cwd->(@_);
}
这里发生了什么？让我们逐行分析
- 我们包含了
Cwd。 - 我们声明了一个变量，并将其赋值为开始时的cwd。这个变量将在线程之间不共享，并包含这个线程的cwd。
- 我们声明了一个我们将用于同步工作的锁变量。
- 在这里，我们获取了
&Cwd::cwd的引用，并将其存储在$Cwd_cwd中。 - 现在，我们拦截了
Cwd::cwd并将其分配给我们的自己的my_cwd，因此每当有人调用Cwd::cwd时，它将调用my_cwd。 my_cwd首先锁定$cwd_mutex，这样就没有人会干扰cwd。- 之后，我们调用
CORE::chdir()来实际将cwd设置为线程期望的位置。 - 然后，我们通过调用第4步中存储的原始
Cwd::cwd并传递给我们手头的任何参数来完成。
实际上，我们已经拦截了Cwd::cwd，并用锁和一个chdir将其包装起来，以便它将报告正确的内容！
现在cwd()已修复，我们需要一种实际更改目录的方法。为此，我们安装自己的全局chdir，就像这样。
*CORE::GLOBAL::chdir = sub {
lock($cwd_mutex);
CORE::chdir($_[0]) || return undef;
$cwd = $Cwd_cwd->();
};
现在，每当有人调用chdir时，我们的chdir将被调用，在其中我们首先锁定控制访问的变量，然后尝试chdir到目录以查看是否可行，否则我们执行真正的chdir，返回undef。如果成功，我们通过调用原始的Cwd::cwd()将新值分配给我们的线程特定的$cwd。
上面的代码实际上足以允许以下内容工作
use threads
use ex::threads::safecwd;
use Cwd;
chdir("/tmp");
threads->create(sub { chdir("/usr") } )->join();
print cwd() eq '/tmp' ? "ok" : "nok";
由于线程中的chdir("/usr")不会影响其他线程的$cwd变量，所以当调用cwd时，我们将锁定线程，将chdir到线程$cwd包含的位置，并执行一个cwd。
虽然这很有用，但我们还需要和睦相处，并添加一些更多功能来扩展此模块的功能。
*CORE::GLOBAL::mkdir = sub {
lock($cwd_mutex);
CORE::chdir($cwd);
if(@_ > 1) {
CORE::mkdir($_[0], $_[1]);
} else {
CORE::mkdir($_[0]);
}
};
*CORE::GLOBAL::rmdir = sub {
lock($cwd_mutex);
CORE::chdir($cwd);
CORE::rmdir($_[0]);
};
上述代码片段对 mkdir 和 rmdir 实现了基本相同的功能。我们锁定 $cwd_mutex 以同步访问，然后 chdir 到 $cwd，最后执行操作。这里值得注意的检查是对于 mkdir 的原型行为是否正确。
接下来让我们看看 opendir、open、readlink、readpipe、require、rmdir、stat、symlink、system 和 unlink。其中没有一个是与上述不同的，唯一的例外是 open。由于它可以接受一个 HANDLE 和一个空标量进行自动验证匿名句柄，因此 open 有一个奇怪的特例。
*CORE::GLOBAL::open = sub (*;$@) {
lock($cwd_mutex);
CORE::chdir($cwd);
if(defined($_[0])) {
use Symbol qw();
my $handle = Symbol::qualify($_[0],(caller)[0]);
no strict 'refs';
if(@_ == 1) {
return CORE::open($handle);
} elsif(@_ == 2) {
return CORE::open($handle, $_[1]);
} else {
return CORE::open($handle, $_[1], @_[2..$#_]);
}
}
从常规的锁定和 chdir() 开始，我们接下来需要检查第一个值是否已定义。如果是，我们必须将其限定为调用者命名空间。如果用户执行 open FOO, "+>foo.txt"，就会发生这种情况。如果用户改为执行 open main::FOO, "+>foo.txt"，则 Symbol::qualify 会注意到句柄已经限定，并返回未修改的句柄。由于 $_[0] 是只读别名，我们不能重新分配它，因此我们需要创建一个临时变量，然后像平常一样继续操作。
现在如果用户使用了新的样式 open my $foo, "+>foo.txt"，我们需要以不同的方式处理。以下代码可以完成功能并完成函数。
else {
if(@_ == 1) {
return CORE::open($_[0]);
} elsif(@_ == 2) {
return CORE::open($_[0], $_[1]);
} else {
return CORE::open($_[0], $_[1], @_[2..$#_]);
}
}
};
为什么我们不能直接将 $_[0] 赋值给 $handle 并统一代码路径呢？因为 $_[0] 是 open my $foo, "+>foo.txt" 中 $foo 的别名，所以 CORE::open 将正确工作。
然而，如果我们执行 $handle = $_[0]，我们将复制未定义的变量，而 CORE::open 不会按照我的意思工作。
因此，我们现在有一个模块，它允许你在大多数情况下安全地使用相对路径，并且大大提高了你将代码移植到线程环境中的能力。我们为此付出的代价是速度，因为每次你进行涉及目录的操作时，你都在序列化你的程序。通常，你根本不会在热路径上执行这类操作。你可能在热路径上对你的文件进行工作，但一旦我们获得了文件句柄，就不再进行锁定。
仍然存在一些问题。在性能方面，system() 存在一个大问题，因为我们无法在 CORE::system() 返回之前获取控制权，所以所有路径操作都会挂起等待。为了解决这个问题，我们需要回到 XS 并在系统调用上进行一些魔法操作。我们还没有能够覆盖文件测试操作符（如 -x 和朋友），也无法对 qx {} 做任何事情。解决这个问题需要使用 B::Generate 和 B::Utils 从上到下处理 optree。也许这个模块的未来版本将尝试这样做，同时使用一个定制的操作来完成锁定。
结论
Perl 中的线程很简单且直接，只要我们留在纯 Perl 领域，一切都会表现得几乎是我们所期望的。将你的模块转换为简单编程的问题，无需进行任何大型的魔法操作。重要的是要记住，考虑你的模块如何可能利用线程使其更容易为程序员使用。
转向 XS 领域完全是另一回事；请等待下一篇文章，它将带我们了解将各种类型的 XS 模块转换为线程安全和线程友好的级别的陷阱。
标签
反馈
这篇文章有什么问题吗？请通过在 GitHub 上创建一个问题或拉取请求来帮助我们。
