MogileFS是一套高效的文件自动备份组件，由Six Apart开发，广泛应用在包括LiveJournal等web2.0站点上。

MogileFS由3个部分组成：
第1个部分是server端，包括mogilefsd和mogstored两个程序。前者即是mogilefsd的tracker，它将一些全局信息保存 在数据库里，例如站点domain,class,host等。后者即是存储节点(store node)，它其实是个HTTP Daemon，默认侦听在7500端口，接受客户端的文件备份请求。在安装完后，要运行mogadm工具将所有的store node注册到mogilefsd的数据库里，mogilefsd会对这些节点进行管理和监控。
第2个部分是utils（工具集），主要是MogileFS的一些管理工具，例如mogadm等。
第3个部分是客户端API，目前只有Perl API(MogileFS.pm)，用这个模块可以编写客户端程序，实现文件的备份管理功能。☆
提供MogileFS.pm

这个天文数字的增长自有它的理由。跑步机变得噪音越来越小，并且使用简单。电脑控制的反馈功能包括心率、热量消耗、速度、速率，还有坡度。许多型号的产品设有预定的运动模式，甚至还有根据练习者的心率变化而自动改变速度与坡度的功能。当然，跑步机受到宠爱的最主要原因还是它在改善体能方面的高效率。

科学研究证 明，跑步机比其他任何有氧运动器械消耗的热量更多。一项在美国威斯康星州医学院进行的研究对跑步机、台阶机、固定自行车、越野滑雪机与划船机的效果进行了 比较。参与者以不同运动强度在不同器械上运动，结果发现，在高强度情况下跑步机是绝对的赢家，1小时能消耗850千卡热量，台阶机与划船趴列第二，第小时 700千卡。在低强度运动时，跑步机仍然是冠军，每小时消耗550千卡，而台阶机的消耗量是500千卡。

跑步机在提高耐力、消耗热量及减少体脂方面效果最为出色。但这些还不是它的惟一用途。跑步机对下肢和上肢的塑形都有很大帮助。以下介绍如何有效地使用跑步机以达到上述目的，重点集中在消耗体脂与热量方面。

1、减脂运动区

如何充分利用跑步机来达到健身减肥的 目的呢?减肥实际上就是一个热量消耗大于热量摄入的公式。如果你能实现负平衡，体脂就会减少。你一定听说过“减脂运动区”的说法，也就是说在最高心率的 65-70%进行有氧运动是最合适的减肥运动强度。这个理论的根据十分简单，在中、低强度运动时，身体能够向工作肌肉提供足够的氧气来进行有氧能量代谢， 而且肌肉在此条件下也能够最大化地利用贮存脂肪作 为热量来源消耗在运动过程中。相反，在高强度运动时，身体不能及时向工作肌肉提供足够的氧气来支持其代谢过程，于是热量在缺氧状态下被分解利用。这时消耗 的主要是碳水化合物，脂肪只占很小一部分。当然，在任何情况下，身体都不会单纯消耗脂肪或碳水化合物，从有氧代谢到无氧代谢有一个转化的过程。因此，如果 你的运动目的是消耗脂肪，这个“减脂运动区”似乎是很有道理的。

但是，如果我们进一步探究热量消耗的问题时会发现，虽然在低强度运动时消耗的脂肪比例较高，但是热量消耗的来源并不对长期减肥的效果产生重要影 响。记住，减肥是一个热量摄入与消耗的平衡问题。低强度运动时消耗的脂肪比例虽然较高，但是高强度运动所消耗的实际脂肪量可能更高，因为总消耗热量被提高 了。

因此，你应该把尽可能地增加单次运动的热量消耗放在第一位，这是实现持续的体内热量负平衡的关键。一项研究比较了两组18～34岁女性的减肥效果。其中一组人用高强度运动，另一组用低强度，两组人的饮食相同。11个星期后，高强度运动组显示出明显的体脂水平下降，而低强度组则没有发生体脂的变化。

高强度运动除了能消耗更多的热量以外，它对身体代谢率的提高效果在运动结束后还会持续一段时间，从而进一步促进了减脂效果。

2、减脂运动方法

由于高强度有氧运动是减肥与防止反弹的最佳方式，那么是否应该在运动中尽可能长时间地保持高强度呢?遗憾的是，虽然那样做可能在单位时间中最大程度地消耗了热量与脂肪，但是身体不可能坚持足够长的时间。因此把短时间的高强度运动与低强度的恢复交替进行是最可行的办法。

如何知道自己的运动强度呢?有两个常用的方法来确认运动强度。第一是用心率来衡量，第二是用“自我评定强度等级”(RPE)来判断。心率测定需 要佩戴一个心率监测器，然后用“220-年龄”的公式预算出你的目标心率。比如，一个35岁的人想采用65%的强度运动，那么计算方法就是(220- 35)×0.65=120。

虽然这个方法被广泛应用，但它有许多缺陷。最大的问题是“220-年龄”得出的最高心率不精确，每个人的实际最高心率会因为体质不同，而高于或 低于这个计算结果。除此以外，运动当天的身体状况，甚至天气，都会影响到心率。相比之下，RPE应该更实用与准确一些。RPE把运动强度分成1～20个不 同等级，1是不做任何努力，20是极度努力。在运动中你根据自己的感觉来做出判断。我们把在跑步机上锻炼的强度简单地分成以下3个档次：

一级——RPE 12～13，较容易，相当于65%心率，

二级——RPE 15～16，有难度，相当于80%心率。

三级——RPE 17～18，非常难，相当于90%心率。

当你在“一级”强度跑步时，应该可以边运动边清楚地说话，但不能唱歌。在“二级”强度时说话有些费力，但努力程度不能太高。你应该能够坚持运动20分钟以上。“三级”强度接近极度努力，只能坚持5～10分钟。

“一级”运动的目的是增强耐力，从高强度运动中恢复体力。“二级”运动，的一个重要目的是提高“乳酸耐受界”。肌肉在此强度下运动时，会在消耗 热量的同时产生许多副产品——乳酸。乳酸经过一系列化学反应可以再次转化为热量供肌肉使用，但是当乳酸的产生速度超过了转化速度而出现堆积，肌肉会迅速疲劳， 被迫降低运动强度直到停止。“二级”强度运动能够提高人体处理乳酸的能力，使你得以保持更长时间的高强度运动.“乳酸耐受界”提高后，曾令人感觉非常吃力 的运动强度会变得比较容易坚持了，你也会消耗掉更多热量与脂肪，“三级”运动强度也能促进这个过程，并改善下肢肌肉，包括臀肌、股二头肌与小腿肌的外形。

跑步机对减肥是种非常理想的运动器械，你能够准确地把握速度，坡度及时间，不管你是一个新手还是资深运动员，都能够根据自己的运动目的特别设计一套锻炼计划。以下是一个把三种运动强度结合在一起，以减肥为目标的周计划。

第一天：小运动量低强度

把跑步机坡度调到1%，强度“一级”，慢跑或快走40～60分钟。你不可能每天都进行高强度锻炼，肌肉需要调整恢复，以便更好地完成任务。

第二天：变速练习

把坡度上升到1%，跑或快走30～60分钟。每5分钟换一次强度，“一级”与“三级”交替进行。随着体能的加强，“三级”的时间也应该相应加长。这意味着持续提高身体的消耗热量能力。

第三天：休息或放松练习

你可以完全休息或练习第一天的内容。

第四天：“乳酸耐受界”练习

把跑步机坡度上升到1%，热身后以“二级”强度跑或快走20分钟。开始阶段你也许只能完成一次20分钟练习，随着体能增强，你会完成2次甚至3次20分钟的强度练习。两次之间慢跑5分钟恢复。

第五天：休息或放松练习(同第一天)

第六天：坡度练习

把跑步机坡度定在4%，用“二级”强度跑或快走1分钟。然后把坡度下降到2%，用“一级”强度跑或快走1分钟。再次提高坡度到5%，用“二级” 强度跑或走5分钟，之后下降到2%，放松1分钟。这样循环直到你达到坡度10%，最后以坡度2%放松5分钟结束。当你的体能得到提高.需要增加强度时，用 加快速度而不是坡度来实现。这个练习对加强下肢力量非常有效.也能改善下肢肌肉的线条。

第七天：休息

无论你的有氧健身目标是什么，使用跑步机都会有所帮助.合理利用这种绝妙的健身工具，你一定能够达到自己的目的。

减少患心脏病的危险

高强度运动不但能提高脂肪消耗能量与体能水平，而且还会降低患心脏病的危险。日本的一项有关长寿的研究证实，高强度的跑步比低强度的步行更能减少患冠心病的危险。

计算热量消耗

大多数跑步机都能显示热量消耗，但是这个数字通常不够准确。以下是一个简便的计算方法。如果你在“一级”强度运动，每分钟大约消耗3～5千卡热 量。中等强度每分钟消耗10千卡，而高强度则消耗15千卡热量。当然，锻炼者的体重因素也应该考虑在内。体重越大，消耗量越多。

很多人都选择跑步机来锻炼，可是你认真考虑过为什么要选择跑步机锻炼吗？请认真地阅读这份跑步机的“说明书”！

一般情况下，人们选择跑步机主要有几个目的，减肥、提高心肺功能、放松、康复等，但是每种目的在跑步机上都有不同的体现。

减肥：时间30～40分钟

因为消耗体内脂肪要在中等强度运动半小时到四十五分钟后才开始，所以，利用跑步机减肥一定要控制好时间和速度。最好将时间设定为30～40分钟，如 果还要进行其他运动，可以减少时间但最好不要低于20分钟，而速度的设定因性别不同存在差异，男的最好在6.5～8.5之间，而女的则最好在 5.5～7.5之间。而且要注意跑步时手臂的摆动，不要扶在扶手上，因为这样可以消耗更多的能量，也更自然安全。

练心肺：速度5～9坡度0%～10%

如果决定要练习自己的心脏，那么最好先去咨询一下运动医学专家。根据他的建议为自己设定目标心率，一般来说，当你在跑步时达到目标心率后，要维持 25～35分钟，而速度最好设定在5～9之间，坡度控制在0%～10%之间。当你完成整个运动后不要急着下来，最好把速度降下来再跑5分钟左后，做好恢复 工作。

热身：时间5～10分钟速度别超过8

如果你想利用跑步机进行热身或放松，时间控制在5～10分钟即可，而速度也最好不要超过8，尤其是在进行准备活动的时候最好循序先用4.5～6的速 度跑 3～5分钟，接着用8～10的速度跑2～3分钟，再降到5～7的速度跑3～5分钟。这样可以避免体力的不必要消耗。坡度用0%～4%就可以。

PERL灵活的进程函数是为了复制进程用于分担任务与程序的工作量。

PERL中复制进程有两种方法：fork()、system()与exec()。

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

fork()部分:*NIX传统的复制进程方法

==============================================================

fork()函数:

作用:进程复制函数。

用法:$pid=fork();

讲解:

无参数；当本进程为父进程时返回值为子进程的PID值，当进程为子进程时返回值为0。

实例:

#!usr/bin/perl -w

$pid=fork(); #复制进程，并把返回值附入$pid

die "Error:$!\n" unless defined $pid; #制定程序的错误机制，此步可略

if($pid!=0){ #条件选择，测试$pid值

print"This is a main pid!PID is $$!\n"; #$pid值不等于0，此为父进程(附:$$为保留变量，其值为此进程的PID)

}else{ #否则.....

print"This is a sub pid!PID is $$!\n"; #$pid值为0，此为子进程

}

exit 1; #退出程序

分析实例:

楼上的程序没有父进程与子进程的明显分化，要将它们分开就要靠测试$pid的值，所以对fork()函数的调用来说条件语句是非常重要的，需要通过它们来辨别fork() 的返回值。

±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±

getppid()函数:

作用:在子进程中调用此函数来获得父进程PID值。

用法:$parent=getppid();

讲解:无参数，调用后其返回值为父进程的PID值。

实例:

#!usr/bin/perl -w

$pid=fork(); #复制进程

die "Error:$!\n" unless defined $pid; #制定错误机制，此步可略

if($pid==0){ #当进程为子进程则进入条件，当进程为父进程则跳过到程序结束

$parent=getppid(); #通过getppid()得到父进程PID值

print"This is a sub pid:$$,the parent is $parent\n"; #在STDOUT打印子进程PID值与其父进程ID值

}

exit 1; #退出程序

注意:楼上的getppid()实例无法在WIN32下通过，建议使用*nix平台。

±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±

关于使用fork():通过fork()创建的子进程共享了父进程的所有变量、句柄等当前值。

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

system()与exec()部分:更直观的进程调用

=============================================================

system()函数:

作用:直接生成子进程。

用法:$result=system("dir/w *.bat"); 或 $result=system("dir/w","*.bat");

讲解:参数为SHELL语句。当函数能正常调用时返回值为0(注意:此与其他函数不一致)，其他返回值均为错误。

实例:

#!usr/bin/perl -w

print STDOUT system("dir/w","*.pl"); #把system()函数中的子进程SHELL语句"dir/w *.pl"的结果输出到STDOUT中

exit 1; #退出程序

#在c:\根目录下运行结果为:

C:\>perl mm.pl

驱动器 C 中的卷没有标签。

卷的序列号是 2629-08EF

C:\ 的目录

aaa.pl bbb.pl zzz.pl xxx.pl SOCK.PL

connect.pl connect2.pl connect3.pl connect4.pl connect5.pl

connect6.pl connect7.pl udpc.pl udps.pl connect8.pl

connect10.pl fork.pl pidd.pl mm.pl

19 个文件 7,503 字节

0 个目录 5,514,014,720 可用字节

0

#注意楼上最后的"0"，这就是返回后的数值，楼上表示程序正常调用了system()函数中的shell语句了。  

±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±

exec()函数:

作用:以指定的SHELL语句代替原进程。

用法:$result=exec("copy *.bat c:\"); 或 $result=exec("copy","*.bat","c:\");

讲解:参数为SHELL语句，成功调用后返回值为undef，其他返回值均为失败。使用此函数后生成的新进程与原进程为同一进程，

有相同的PID，共享变量语柄等一切当前值。

实例与system()相当，所以不作讨论了。

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

附:关于"Perl的管道"部分内容博大精深，而本人又水平有限，所以只好草草了事，如果有哪里不妥还望各位前辈指点

管道是为了使不同进程可以进行通信的制定的。管道是*NIX编程的重点。

与其相关的函数有:open()、pipe()等等。

open():作打开句柄用。

格式:open(FILEHANDLE,"符号+参数");

例子:open(NIX,"|wc -lw"); #打开名为NIX的管道，其进程为‘wc -lw’，管道为写入。

open(DDD,"dir c:\|"); #打开名为DDD的管道，其进程为‘dir c:\’，管道为读取。

讲解:FILEHANDLE(句柄)包括很多成分，如文件句柄、SOCKET句柄、管道句柄，此文只谈到管道句柄。

第二个参数为双引号或单引号相括着的管道符号与参数。管道符号为"|"，把管道符号放到参数的左边为‘只读’，放到右边为‘只写’，如果两边都有便为双向管道(既可读也可写)。

简单的管道实例:

#!usr/bin/perl -w

open(AAA,"dir d:|"); #打开管道AAA,进程为"dir d:"，只读

@bbb=<AAA>; #从管道中读取内容，并压入@bbb数组

print"@bbb\n"; #把@bbb数组全部输出到STDOUT

close AAA; #关闭管道AAA

exit 1; #退出程序

〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

pipe():创建管道对。

格式: pipe(READ,WRITE);

实例:pipe(README,WRITEME); #创建了一个管道对，"README"用于读，"WRITEME"用于写。

$aaa=pipe(AAA,BBB); #创建了一个管道对，"AAA"用于读，"BBB"用于写，$aaa变量为调用pipe()的返回值。

讲解:正常调用后返回值为非零数，第一个参数为被创建的读管道，第二个参数为被创建的写管道。此函数通常配合进程中

的fork()函数一同使用，步骤是先使用pipe()函数建立管道对，再使用fork()创建新进程，在不同的进程关闭不同的

管道，这样就可以达到管道间通信的目的了。

〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

close():关闭管道

格式: close(AAA);

close BBB;

实例与格式相当，也就不详细介绍了。

讲解:close()在调用时能将子程序的终止代码放到特殊变量$?中；当关闭的是写管道时close()调用将进入堵塞状态直至另一

端完成它的全部工作为止。

信号其实就是编程里俗称的中断，它使监视与控制其他进程变为有可能。

首先说说通用信号，通用信号归纳起来可以组成以下列表:

=============================================================

信号名 值 标注 解释

------------------------------------------------------------------------

HUP 1 A 检测到挂起

INT 2 A 来自键盘的中断

QUIT 3 A 来自键盘的停止

ILL 4 A 非法指令

ABRT 6 C 失败

FPE 8 C 浮点异常

KILL 9 AF 终端信号

USR1 10 A 用户定义的信号1

SEGV 11 C 非法内存访问

USR2 12 A 用户定义的信号2

PIPE 13 A 写往没有读取者的管道

ALRM 14 A 来自闹钟的定时器信号

TERM 15 A 终端信号

CHLD 17 B 子进程终止

CONT 18 E 如果被停止则继续

STOP 19 DF 停止进程

TSTP 20 D tty键入的停止命令

TTIN 21 D 对后台进程的tty输入

TTOU 22 D 对后台进程的tty输出

------------------------------------------------------------------------

著明:上表中‘值’列下没有列出的值所对应的信号为系统调用的非标准信号，在此

文不予以探讨。上表中的第三列‘标注’定义了当进程接受到信号后的操作，

如:

A-----终止进程

B-----忽略进程信号

C-----终止进程并卸下内核

D-----停止进程

E-----恢复进程

F-----不能截取或忽略进程信号

=============================================================

下面就以INT作范例演示一下调用过程吧:

#!usr/bin/perl -w

#c:\test11.pl

my $aaa=0; #对计数器变量$aaa进行负值

while($aaa<3){ #进入循环体

print"Begin\n"; #打印字符串到STDOUT

sleep(5); #睡眠函数，参数为5秒

next unless $SIG{INT}=\&demon; #选择结构，demon子程序值负于中断函数

}

sub demon{ #demon子程序体

$aaa++; #计数器自加

print"Stop!\n"; #打印字符串到STDOUT

}

exit 1; #退出程序

输出结果:在SHELL里不停的打印出"Begin"字样，相隔5秒，一但在键盘中执行程序

中断操作(Control+"c")，屏幕就会打印出"Stop!"字样，不停地继续下去。

中断调用总结:调用需要使用到系统保留全局HASH数组%SIG，即使用"$SIG{信号名}"

截取信号，截取后将其负某个代码(子函数)的地址值，这代码就是截

取后要执行的结果了。

最近一直有在学习POE，这是一个类似于状态机的网络框架，在python上有叫twisted的类似框架。为此也看了一些文章，并学习了一些例子。
对 于SOCKET编程，也许是很久没有用了的缘故，看到相关的一段程序时，感觉相当地眼生。还因为之前一直是用perl原生的socket命令来写的，所以 对IO::Socket没有做过多的了解。再去看书，或者将perldoc里的内容从头到尾地通读一遍，一来没有什么兴趣，二来就以往经验来看很多内容都 是很少用到的，看了也容易忘记。所以就将这段代码抄了一遍，对于其中不了解或者有疑问的再去查perldoc，或者写一些测试代码来验证。事实证明收获也 是不小，很快就了解了其中的主要内容，顺带地还将POSIX中的一些常量搞搞清楚。更重要的是在抄写这样规范的代码，对于自身编写程序的格式也会有潜移默 化的影响。
这么做的关键在于，首先要有一段好的代码，第二不要抱着得过且过的心态放过一些细节。

#!/usr/bin/perl

use warnings;
use strict;

use POSIX;
use IO::Socket;
use IO::Select;
use Tie::RefHash;

# Create the server socket.

my $server = IO::Socket::INET->new(
        LocalPort => 12345,
        Listen => 10,
    ) or die "can't make server socket: $@\n";
    
$server->blocking(0);

# Set structures to track input and output data.

my %inbuffer = ();
my %outbuffer = ();
my %ready = ();

tie %ready, "Tie::RefHash";

# The select loop itself.

$my select = IO::Select->new($server);

while(1) {
    
    # Process sockets that are ready for reading.
    foreach my $client( $select->can_read(1) ) {
        handle_read($client);
    }
    
    # Process any complete requests. Echo the data back to the client,
    # by putting the ready lines into the client's output buffer.
    foreach my $client ( keys %ready ) {
        foreach my $request ( @{ $ready{$client} } ) {
            print "Got request: $request\n";
            $outbuffer{$client} .= $request;
        }
        delete $ready{$client};
    }
    
    # Process sockets that are ready for writing.
    foreach my $client ( $server->can_write(1) ) {
        handle_write($client);
    }
}

exit;

# Handle a socket that's ready to be read from.

sub handle_read {
    my $client = shift;
    
    # If it's the server socket, accept a new client connection.
    if ( $client == $server ) {
        my $new_client = $server->accept();
        $new_client->blocking(0);
        $select->add($new_client);
        return;
    }
    
    # Read from an established client socket.
    my $data = "";
    my $rv = $client->recv( $data, POSIX::BUFSIZ, 0 );
    
    # Handle socket errors.
    unless ( defined($rv) and length($data) ) {
        handle_error($client);
        return;
    }
    
    # Successful read. Buffer the data we got, and parse it into lines.
    # Place the lines into %ready, where they will be processed later.
    $inbuffer($client) .= $data;
    while ( $inbuffer{$client} =~ s/(.*\n)// ) {
        push @{ $ready{$client} }, $1;
    }
}

# Handle a socket that's ready to be write to.

sub handle_write {
    my $client = shift;
    
    # Skip this client if there's nothing write.
    return unless exists $outbuffer{$client};
    
    # Attempt to write pending data to the client.
    my $rv = $client->send( $outbuffer{$client}, 0 );
    unless ( defined $rv ) {
        warn "I was told I could write, but I can't.\n";
        return;
    }
    
    # Successful write. Remove what was sent from the output buffer.
    if ( $rv == length( $outbuffer{$client} ) or $! ==POSIX::EWORLDBLOCK ) {
        substr( $outbuffer($client), 0, $rv ) = "";
        delete $outbuffer{$client} unless length $outbuffer{$client};
        return;
    }
    
    # Otherwise there was an error.
    handle_error($client);
}

# Handle client error. Clean up after dead socket.
sub handle_error {
    my $client = shift;
    
    delete $inbuffer{$client};
    delete $outbuffer{$client};
    delete $ready{$client};
    
    $select->remove($client);
    close $client;
}

原作者:Brian Slesinsky 1997年5月7日
编译者:【Perl之旅】Nighthawk 2000年7月15日
Brian Slesinsky原来是HotWired公司的工程师，后来他离开公司忙于自己事业。

前言:

我对在线聊天没有什么兴趣,说是实在的,与电子邮件和网络会议系统相比,聊天室显得很肤浅.但是写一个聊天室服务程序倒是一件很有意思的事情.我将告诉你如何来写一个小型的聊天室服务程序,可能会很简陋,有很多要扩展的地方.

先决条件:

你 必须有很好的Perl编程的知识,一台服务器,安装Perl 5.002或更高的版本.注意大多数ISP不会允许普通用户运行聊天室程序.但是你也许可以通过一个MODEN连接来与少数几个用户试试你的聊天室系统. (如果你从CPAN获得了最新版本的IO:Select,这个聊天室程序可以在Windows环境下使用).

你还需要一个telnet客户端程序,因为我们要用来做聊天室的客户端.



Socket简易编程:

开 始聊天,你需要在internet上建立一个连接,对Perl程序员来说,这意味着要和socket打交道.而以前这是很困难的,因为你不得不使用 pack()来建立一个C结构来进行底层的系统调用.但在最新版的Perl中我们可以使用IO::Socket包,很容易地打开一个socket. 当用户连接聊天服务器时,telnet程序在指定的端口打开一个连接,所以服务器也必须在那个端口打开一个socket,监听所有进来的连接.下面如何通 过IO::Socket来做到这一点:

    use IO::Socket;

    my $listening_socket =
        IO::Socket::INET->new(Proto => 'tcp',
                              LocalPort => 2323,
                              Listen => 1,
                              Reuse => 1) or die $!;

所有参量的含义:

Proto: 定义网络所用的协议 - 在这里我们用的是TCP. 在internet上通常有两种协议用得比较广泛 - TCP 和 UDP. TCP适用于稳定的连接,可以重新发送丢失的数据包,而UDP用于那些不用重发数据包的场合(如实时音频数据流).

LocalPort: 定义连接的端口号.

Listen: 我们将监听来自其它计算机的连接,而不是自己建立一个连接.所以用户要先telnet到端口2323,然后运行了聊天服务程序的计算机来建立连接.

Reuse: 这个选项意思是如果我们"杀掉"聊天服务程序然后再重新启动,将能够马上重新使用原来的端口,而不用等待以前那个连接完全结束.



我们正等待某个连接的到来.... 一个连接到来以后,我们需要accept这个新的连接:

$socket = $listening_socket->accept;

一旦我们建立了一个连接,我们可以发送一些文字给这个用户(还不完全是,请看本文的结尾部分):

$socket->send("hello\r\n") or print "connection closed at other end\n";

我们也可以接收用户发来的信息:

$socket->recv($line, 80);
if($line eq "") {
print "connection closed at other end\n";
}

最后我们完成了连接,可以关闭它:

$socket->close;

大部分程序只在一个时刻处理一个用户.如果用户还没有准备好,程序就没有什么好做的.所以Perl程序没有从读到什么东西,它就停下来等待直到用户准备好. (这叫blocking I/O.)

这种方式不能用于聊天服务程序,用户不可能排着队来.一个用户可能离开去喝些咖啡,但其它用户还在拼命地敲打键盘(聊天),服务程序还得处理他们的信息.

解 决这个问题的一个办法是为每个用户创建一个入口(entity),或者用fork()创建另外一个进程,或者用多线程编程方法(遗憾地是Perl还用不 了).这样系统就可以为多个用户服务, 但每个用户有他自己的入口(entity)等待他输入命令. 但是进程的系统开销比较大,如果很多用户登录的话,系统资源很快会变得不足.最好是用一个进程来处理所有人的请求.

我们真正需要的是要知道谁正在等待服务,必须马上处理(除非没有一个人想聊天).这就是select()函数所要做的.

象socket函数一样,select()曾经也是很难用,所以大多数程序员都尽量避免使用它. 但Perl给它加了一个面向对象编程的包装,叫做IO::Select,使得使用非常简单.

假设我们要等待两个sockets, $thing1 and $thing2. 首先我们创建一个包含两个socket的select()对象:

$select = IO::Select->new($thing1,$thing2);

下一步,当我们需要知道谁有数据要处理时,我们就查询select对象:

my @ready = $select->can_read;

这个调用将等待直到$thing1或$thing2中任何一个准备好, 它将返回一个包含socket的数组. (如果它们都准备好了,@ready将包含两个socket.) 一旦有了准备好的socket, 我们一个一个地读取数据找出它们发送的是是什么:

   for $socket (@ready) {
        $socket->recv($line,80);
        if($line eq "") { die "they hung up on me"; }
        print "someone sent $line.  Sending it back.\n";
        $socket->send($line) or die "hey, where did they go?";
   }

现在我们有足够的片段来写我们的第一个聊天服务程序. 这个聊天室里的交谈没有什么意思,除非你中意和自己聊天 - 服务程序会把你说的全部回送. 但它将告诉你如果结合socket和select()来建立一个一个时刻只能做一件事的服务器.下面是程序源码:

#!/usr/local/bin/perl -wT
require 5.002;
use strict;
use IO::Socket;
use IO::Select;

#创建一个socket然后监听一个端口
my $listen = IO::Socket::INET->new(Proto => 'tcp',
   LocalPort => 2323,
   Listen => 1,
   Reuse => 1) or die $!;

# 开始$select只包含我们监听的socket
my $select = IO::Select->new($listen);

my @ready;

#等待,直到有事情发生
while(@ready = $select->can_read) {

    my $socket;

    # 处理每个准备好了的socket
    for $socket (@ready) {

# 如果被监听的socket准备好了,接收一个新的连接
if($socket == $listen) {
    my $new = $listen->accept;
    $select->add($new);
    print $new->fileno . ": connected\n";
} else {

    # 否则读入一行文字,然后发送回去
    my $line="";
    $socket->recv($line,80);
    $line ne "" and $socket->send($line) or do {

# 如果没有什么可发送和接收的,中断连接
print $socket->fileno . ": disconnected\n";
$select->remove($socket);
$socket->close;
    };
}
    }
}



广播:

接下来的工作是把聊天信息发送给所有的用户(不光是你自己),也就是所谓"广播".

我们可以用$select, 它new()或add()来返回所有给$select的sockets,从而得知"所有用户"到底是谁.我们来修改下程序:


            $socket->recv($line,80);
            if($line eq "") {
                print $socket->fileno . ": disconnected\n";
                $select->remove($socket);
                $socket->close;
            };
            my $socket;

            # 向所有用户广播.如果send()失败了就关闭连接.
            
            for $socket ($select->handles) {
                next if($socket==$listen);
                $socket->send($line) or do {
                    print $socket->fileno . ": disconnected\n";        
                    $select->remove($socket);
                    $socket->close;
                };
            }

下面是这个聊天程序的所有代码:


#!/usr/local/bin/perl -wT
require 5.002;
use strict;
use IO::Socket;
use IO::Select;

#创建一个socket监听端口
my $listen = IO::Socket::INET->new(Proto => 'tcp',
   LocalPort => 2323,
   Listen => 1,
   Reuse => 1) or die $!;

#$select只包含我们正在监听的socket
my $select = IO::Select->new($listen);

my @ready;

# 等待
while(@ready = $select->can_read) {

    my $socket;

    # 处理每个准备好的端口
    for $socket (@ready) {

# 如果被监听的端口准备好,接收一个新的连接
if($socket == $listen) {
    my $new = $listen->accept;
    $select->add($new);
    print $new->fileno . ": connected\n";
} else {

    # 读入一行文字
    # 如果recv()失败,关闭连接
    my $line="";
    $socket->recv($line,80);
    if($line eq "") {
print $socket->fileno . ": disconnected\n";
$select->remove($socket);
$socket->close;
    };
    my $socket;

    # 向所有人广播,如果send()失败则关闭连接.
    for $socket ($select->handles) {
next if($socket==$listen);
$socket->send($line) or do {
    print $socket->fileno . ": disconnected\n";
    $select->remove($socket);
    $socket->close;
};
    }
}
    }
}

1;
            


我是谁?



我们的聊天程序还有一个问题,就是我们不知道是谁在说话.真正的聊天室服务器能让你知道谁是谁,在发言后面把他们的名字显示出来.

如果我们只能在一个时刻做一件事情,请求一个handle的较为直接的程序代码就象这个样子:

         my $new = $listen->accept;
            $select->add($new);
            print $new->fileno . ": connected\n";
            $new->write("choose a handle> ");
            $handle[$new->fileno] = $new->recv;
            

问题是,我们不能要服务器停下来等待用户输入,我们需要把用户在那里的信息保存下来,当一个用户在输入的时候,可以处理其他用户,当这个用户输入完了以后在回来.完成这些功能的代码可以分为两部分:

sub login {
            my($new) = @_;
            $select->add($new);
            print $new->fileno . ": connected\n";
            $new->write("choose a handle> ");
            save_where_we_are();
        }

        sub get_handle {
            my($socket) = @_;
            $handle[$socket->fileno] = $socket->recv;
        }
        
#!/usr/local/bin/perl -wT
require 5.002;
use strict;
use IO::Socket;
use IO::Select;

my $port = scalar(@ARGV)>0 ? $ARGV[0] : 2323;

$| = 1;
my $listen = IO::Socket::INET->new(Proto => 'tcp',
   LocalPort => $port,
   Listen => 1,
   Reuse => 1) or die $!;
$ENV{'PATH'} = "/usr/bin";
my $date = `date`;
warn "started on $port on $date";
my $select = IO::Select->new($listen);
my @chatters;

# 在win32中,注释掉下面这句
$SIG{'PIPE'} = 'IGNORE';

my @ready;
while(@ready = $select->can_read) {
    print "going: ".join(', ',map {$_->fileno} @ready) . "\n";
    my $socket;
    for $socket (@ready) {
if($socket == $listen) {
    my $new_socket = $listen->accept;
    Chatter->new($new_socket, $select, \@chatters);
} else {
    my $chatter = $chatters[$socket->fileno];
    if(defined $chatter) {
&{$chatter->nextsub}();
    } else {
print "unknown chatter\n";
    }
}
    }
}

package Chatter;
use strict;

sub new {
    my($class,$socket,$select,$chatters) = @_;

    my $self = {
'socket' => $socket,
'select' => $select,
'chatters' => $chatters
};
    bless $self,$class;

    $chatters->[$socket->fileno] = $self;
    $self->select->add($socket);

    $self->log("connected");
    $self->ask_for_handle;

    return $self;
}

sub socket { $_[0]->{'socket'} }
sub select { $_[0]->{'select'} }
sub chatters { $_[0]->{'chatters'} }
sub handle { $_[0]->{'handle'} }
sub nextsub { $_[0]->{'nextsub'} }

sub ask_for_handle {
    my($self) = @_;
    my $welcome =<< END;

欢迎你来到我的聊天室.

使用指南:
请注意这个聊天室程序不完全兼容telnet协议,所以有些telnet客户端程序可能不工作,抱歉!
如果你输入的字符都分行显示,请退出然后试一试其它的telnet客户端程序,最好发一个电子邮件
(bslesins-code\@hotwired.com)告诉我你用的是什么程序.

我们已经试过下面的客户端程序,它们都能很好的工作:
  - "telnet" on Solaris
  - "telnet" on IRIX
  - CRT on Windows 95
我们已经收到报告,微软的Telnet不能工作.

另外,有些人登录以后可能去干别的事情了,所以他们不会马上看到你的信息.所以输入以后,保持telnet
窗口开着,等待一会儿.

关闭你的telnet窗口就可以退出.或者假如你是在Unix命令行运行telnet的话,按Control-]然后在提示中按"close"键.

__Brian__

END
    $welcome =~ s:\n:\r\n:g;
    $self->write($welcome);

    $self->write("choose a handle> ");

    $self->{'nextsub'} = sub { $self->get_handle };
}

sub get_handle {
    my($self) = @_;

    my $handle = $self->read or return;
    $handle =~ tr/ -~//cd;
    $self->{'handle'} = $handle;
    $self->broadcast("[$handle is here]");
    $self->log("handle: $handle");
    $self->{'nextsub'} = sub { $self->chat };
}

sub chat {
    my($self) = @_;

    my $line = $self->read;
    return if($line eq "");
    $line =~ tr/ -~//cd;
    my $handle = $self->handle;
    $self->broadcast("$handle> $line");
}

sub broadcast {
    my($self,$msg) = @_;

    my $socket;
    for $socket ($self->select->handles) {
my $chatter = $self->chatters->[$socket->fileno];
$chatter->write("$msg\r\n") if(defined $chatter);
    }
}

sub read {
    my($self) = @_;

    my $buf="";
    $self->socket->recv($buf,80);
    $self->leave if($buf eq "");
    return $buf;
}

sub write {
    my($self,$buf) = @_;
    $self->socket->send($buf) or $self->leave;
}

sub leave {
    my($self) = @_;

    print "leave called\n";

    $self->chatters->[$self->socket->fileno] = undef;
    $self->select->remove($self->socket);
    my $handle = $self->handle;
    $self->broadcast("[$handle left]") if(defined $handle);
    $self->log("disconnected");
    $self->socket->close;
}

sub log {
    my($self,$msg) = @_;
    my $fileno = $self->socket->fileno;
    print "$fileno: $msg\n";
}

__END__

# and here's a chat server in 4 lines :-)

#!/usr/local/bin/perl -- minchat: run and telnet to port 5555 - bslesins
sub p{print@_}$SIG{CHLD}=sub{wait};socket S,2,2,6;bind S,pack(Snx12,2,5555);
listen S,5;while(accept C,S){if(!fork){open(STDOUT,">&C");p"name:";$n=substr
,0,-2;$f=fork||exec"tail -f chatlog";open W,">>chatlog";select(W);$|=1;p
"[$n here]\r\n";while(){p"$n> $_";}p"[$n gone]\r\n";kill 15,$f;exit}}



如何保存用户位置信息呢? 一个方法是保存一个子程序的指针,而这个子例程包含了下一步该做什么:

$nextsub[$socket->fileno] = &get_handle;

这样我们就可以在@nextsub中适当的入口找到我们出发的位置. 综合以上所述,我们把程序整理如下.





剩下的工作:

我们的聊天室程序还不是一个完整的作品,如果你象把它放在你的服务器上工作,还有许多事情要做.他们是:

输入缓冲区: 关于recv()函数,它并不总是每次接收一行数据.一个真正的聊天服务器需要把recv()的结果添加到缓冲区中,并找到折行字符,把它分成几行.

输出缓冲区: 如果有人挂起它的telnet进程太长时间,调用send()会中断它.但可以用select()来发现一个socket是否已经准备好.

更好地支持telnet协议

加入常用的命令:帮助,列出在聊天室中的用户名单,退出等等

用户账号密码保护

多个聊天房间

权限控制

私人聊天房间

等等...

基于perl,使用IO::Select实现，并非多线程。可指定分几部分下载。
基本上没有作异常处理，没有处理redirect,甚至也没有判断对range头的响应是否为206.

还好的是它还可以工作，比wget快几倍地下载,挺好玩的.

perl module:

package HttpClient;

use strict;
use warnings;

use IO::Socket::INET;
use Data::Dumper;

my $crlf = “\r\n”;

my $buf_size = 8 * 1024;

sub new {
my $class = shift;
my %cnf = (@_);
my $self = {
state => ‘init’,
url => $cnf{url},
‘total_parts’ => $cnf{’total_parts’},
part => $cnf{part},
‘content_length’ => $cnf{’content_length’},
};
my $url = $self->{url};
my $host = $1 if $url =~ m{://([^/]*)};
my $file = $1 if $url =~ m{/([^/]*)$};
if ( defined $self->{part} ) {
$file .= “.part” . $self->{part};
}
$self->{host} = $host;
$self->{file} = $file;
my $port = 80;
$port = $1 if $host =~ /:(\d+)/;
my $sock = IO::Socket::INET->new(
PeerAddr => $host,
PeerPort => $port,
Proto => ‘tcp’,
Blocking => 0,
)
or die “can’t connect to server:$!\n”;
select($sock);
$| = 1;
select(STDOUT);
$self->{sock} = $sock;
bless $self, $class;
return $self;
}

sub sock {
return shift->{sock};
}

sub get_request_header {
my $self = shift;
return $self->{request} if defined $self->{request};
my $request =
“GET $self->{url} HTTP/1.1$crlf”
. “Host: $self->{host}$crlf”
. “Connection: close$crlf”;
if ( defined $self->{’total_parts’}
and defined $self->{part}
and defined $self->{’content_length’} )
{
my $length = $self->{’content_length’};
my $total_parts = $self->{’total_parts’};
my $part = $self->{part};
my $part_size = int( $length / $total_parts );
my $start_pos = $part_size * $part;
my $recved = 0;
if (-e $self->{file}) {
$recved = -s $self->{file};
$start_pos+=$recved;
}

my $recv_size =
( $part == $total_parts - 1 ) ? $length-$part*$part_size : $part_size;
$self->{start_pos} = $start_pos;
$self->{recv_size} = $recv_size-$recved;
print “part $self->{part} recv_size=$self->{recv_size},start_pos=$start_pos,recved=$recved,parts=$total_parts,length=$length\n”;
$request .=
“Range: bytes=$start_pos-” . ( $start_pos + $recv_size-1 ) . $crlf;
}
$request .= $crlf;
$self->{request} = $request;
return $request;
}

sub parse_header {
my ($self) = @_;
my $data = $self->{data};
return 1 if $self->{state} =~ /body/;
return 0 unless defined $data;
return 0 unless $data =~ m{^(.*?)(\r\n\r\n|\n\n)}s;
my $header_content = $1;
my $header_end = $2;
print $header_content, “\n”;
my @headers = split /\r?\n/, $header_content;
die “invalid header\n” unless scalar(@headers) > 0;
my $status_line = shift @headers;
$self->{status_line} = $status_line;
$self->{code} = $2 if $status_line =~ m{HTTP/1(.1)? (\d+)};
my $last_header;
my $header = {};

foreach my $line (@headers) {
if ( $line =~ /^\s+(.*)$/ ) {
$header->{$last_header} .= ” $1″;
}
elsif ( $line =~ /^([^:]+): (.*)$/ ) {
$last_header = $1;
my $value = $2;
$header->{$last_header} = $value;
}
else {
print “invalid header:$line\n”;
}
}
$self->{header} = $header;
$self->{’content_length’} = $header->{’Content-Length’}
unless defined $self->{’content_length’};
$self->{recv_size} = $self->{’content_length’};
$self->{data} = substr($data,length($header_content)+length($header_end));
$self->{state} = ‘body’;
return 1;
}

sub recv_data {
my ( $self, $data ) = @_;
if ( defined $self->{data} ) {
$self->{data} .= $data;
}
else {
$self->{data} = $data;
}
}

sub save_data {
my ( $self, $read_select ) = @_;
my $fh = $self->{fh};
if ( !defined $fh ) {
open $fh, “>$self->{file}” or die “can’t open file $self->{file} :$!\n”;
binmode $fh,”:bytes”;
$self->{fh} = $fh;
}
my $write_len = $self->{write_len} || 0;
my $recv_size = $self->{recv_size};
my $data = $self->{data};
my $max_len = length($data);
return unless $max_len > 0;
if ($max_len+$write_len > $recv_size) {
$max_len = $recv_size - $write_len ;
my $part = $self->{part} || 0;
print “part=$part,max_len=$max_len,write_len=$write_len\n”;
}

if ( $max_len == 0 ) {
$self->{done} = 1;
close $self->{fh};
$read_select->remove( $self->sock );
close $self->{sock};
print “$self->{file} recved $write_len bytes\n”;
$self->{parent}->child_done($self) if $self->{parent};
return;
}
my $len = syswrite( $fh, $data, $max_len )
or die “write data failed :$!\n”;
$self->{data} = substr( $data, $len );
$write_len += $len;
$self->{write_len} = $write_len;
}

sub child_done {
my ( $self, $child ) = @_;
$child->{done} = 1;
return unless $self->{done};
foreach my $c ( @{ $self->{children} } ) {
return unless $c->{done};
}

print “merge file\n”;
open FH, “>>$self->{file}”;
print “first part size:”,-s $self->{file},”\n”;
seek( FH, 0, 2 );
foreach my $c ( @{ $self->{children} } ) {
print “$c->{file} size:”,-s $c->{file},”\n”;
open CFH, “<$c->{file}”;

print “merge $c->{file}\n”;
my $buf;
for ( ; ; ) {
my $len = sysread( CFH, $buf, $buf_size );
last if !defined $len || $len == 0;
syswrite( FH, $buf, $len );
}
close CFH;
unlink $c->{file};
}
close FH;
}

sub handle_read {
my ( $self, $sock, $read_select, $write_select, $sock_client ) = @_;

my $data;
my $len = sysread( $sock, $data, $buf_size );
if ( $len == 0 ) {
print “sock $sock finished\n”;
$read_select->remove($sock);
close $sock;
print “$self->{file} size=”,-s $self->{file},”\n”;
$self->{parent}->child_done($self) if $self->{parent};
return;
}
$self->recv_data($data);
if ( $self->{state} !~ /body/ and $self->parse_header ) {
if ( !defined $self->{parent} and defined $self->{content_length} ) {
my $parts = $self->{total_parts} || 5;
$self->{children} = [];
my $length = $self->{’content_length’};
my $part_size = int( $length / $parts );
$self->{recv_size} = $part_size;
print “parent recv_size=$self->{recv_size}\n”;
foreach my $part ( 1 .. $parts - 1 ) {
my $child = HttpClient->new(
url => $self->{url},
‘total_parts’ => $parts,
part => $part,
‘content_length’ => $self->{content_length},
);
$sock_client->{ $child->sock } = $child;
$child->{parent} = $self;
push @{ $self->{children} }, $child;
$read_select->add( $child->sock );
$write_select->add( $child->sock );
}
}
}
else {
$self->save_data($read_select);
}
}

sub handle_write {
my ( $self, $sock, $read_select, $write_select, $sock_client ) = @_;

my $offset = 0;
$offset = $self->{request_offset} if defined $self->{request_offset};
my $request = $self->get_request_header;
if ( $offset == 0 ) {
print “try to send request\n”;
print $request;
}
print “offset=$offset\n”;
my $len = syswrite( $sock, $request, length($request) - $offset, $offset );
if ( !defined $len ) {
print STDERR “write failed:$!\n”;
$read_select->remove($sock);
$write_select->remove($sock);
}
else {
$offset += $len;
$self->{request_offset} = $offset;
if ( $offset == length($request) ) {
$write_select->remove($sock);
}
}
}

sub start {
my ($self) = @_;
use IO::Select;
my $r = IO::Select->new;
$r->add( $self->sock );

my $w = IO::Select->new;
$w->add( $self->sock );

my $sock_client = { $self->sock => $self };

use Time::HiRes qw(time);
my $start_time = time;
for ( ; ; ) {
last if ( $r->count == 0 );
my ( $rout, $wout, $eout ) = IO::Select->select( $r, $w, $r );
last unless defined $rout;

foreach my $sock ( @{$wout} ) {
my $c = $sock_client->{$sock};
if ( !defined $c ) {
die “oops,can’t find httpclient for $sock\n”;
}
$c->handle_write( $sock, $r, $w, $sock_client );
}
foreach my $sock ( @{$rout} ) {
my $c = $sock_client->{$sock};
if ( !defined $c ) {
die “oops,can’t find httpclient for $sock\n”;
}
$c->handle_read( $sock, $r, $w, $sock_client );
}
}
my $end_time = time;
my $used_time = $end_time - $start_time;
my $speed = $self->{content_length} / $used_time;
print “Done,spend $used_time seconds,speed:$speed bytes/seconds\n”;
}

1;

test perl script:

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

use lib ‘.’;

use HttpClient;
use Getopt::Long;
$| = 1;
#my $url = ‘http://eclipse.cdpa.nsysu.edu.tw/downloads/drops/R-3.2.1-200609210945/eclipse-SDK-3.2.1-linux-gtk.tar.gz’;

my $url = ”;
my $total_parts = 1;
my $result = GetOptions (”url|u=s” => \$url,
                        “parts|p=i”   => \$total_parts,
                        );
unless ($result and $url=~m{://}) {
    print <<HELP
usage: perl http.pl –url=url [–parts=parts]
HELP
;
    exit;
}

my $client = HttpClient->new(url=>$url,’total_parts’=>$total_parts);
$client->start();

zz <http://blog.csdn.net/evane1890/archive/2007/06/02/1635452.aspx>

 

关键字: mac tiger 中文

LY from http://fanqiang.chinaunix.net/program/perl/2005-06-28/3349.shtml

是否觉得perl中关于模块的文档有些难懂？好的，这里有一个世界上最简单的模块，它将用于展示(demonstrate)Exporter模块所 有的特性，另外还有一段使用这个模块的脚本。同时，我们也会给出一个有关于@INC的简短说明，最后，还要讲一下有些关于using warnings和use模块的使用。

下面是这个模块的内容：

MyModule.pm

package MyModule;

use strict;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

$VERSION     = 1.00;
@ISA         = qw(Exporter);
@EXPORT      = ();
@EXPORT_OK   = qw(func1 func2);
%EXPORT_TAGS = ( DEFAULT => [qw(&func1)],
                 Both    => [qw(&func1 &func2)]);

sub func1  { return reverse @_  }
sub func2  { return map{ uc }@_ }

1;

首先，我们将通过声明 "package" 名字来获得一个名字空间。这将确保模块中的方法与变量，和调用他们的代码所分隔开来。 use strict在模块中是一个非常好的做法，这将使Perl对使用全局变量做出一定的约束。详细介绍参看 "use strict warnings and diagnostics or die" 。

我们需要用Exporter模块来将我们的函数从MyModule::namespace输出到main::namespace，让使用 MyModule的程序可以使用这些函数。 为了use strict，我们必须使用use vars来声明一些变量。当然，在5.6版本以上我们还可以使用our来声明变量。 我们现在设置一个$VERSION数值，然后通过使用@ISA来使得Exporter成为MyModule的一部本。想要了解@ISA是什么以及如何使用 等细节，请参考"perlboot"。

@EXPORT包含了我们需要默认输出的函数列表。在这里，它是空的。一般来说，你通过默认的使用@EXPROT输出的越少越好。因为调用该模块的 程序中，有可能存在与其中函数相之冲突的函数或者代码。如果程序需要调用某个指定的函数，那么，就请就让它主动请求。 @EXPORT_OK包含了我们在调用时需要输出的函数列表，我们只输出了&func1和&func2，这种方法要优先于盲目地使用 @EXPORT来输出函数。你也可以输出像$CONFIG这样全局的、不是用my定义的字义范畴的变量。（可参考用 "our" 或者 use vars来声明全局变量） %EXPORT_TAGS.为了方便起见，我们定义了两套输出标签。‘:DEFAULT’标签只输出&func1；‘:Both’标签则输出 &func1和&func2。这个哈希表存储指向数组引用的标签。注意：在这里的数组是匿名的。 最后，我们需要在模块结尾加上一个“1;”。因为当perl装载一个模块时，它会实现查看这个模块是否能在最后返回一个真值，并且据此判断该模块是否已装 载成功。当然，你可以在最后面添加任何真值（参看 "Code::Police" ），但其中1是最方便的。

MySciprt.pl（使用MyModule的一个例子）

#!/usr/bin/perl -w

use strict;

# you may need to set @INC here (see below)

my @list = qw (J u s t ~ A n o t h e r ~ P e r l ~ H a c k e r !);

# case 1
# use MyModule;
# print func1(@list),"\n";
# print func2(@list),"\n";

# case 2
# use MyModule qw(&func1);
# print func1(@list),"\n";
# print MyModule::func2(@list),"\n";

# case 3
# use MyModule qw(:DEFAULT);
# print func1(@list),"\n";
# print func2(@list),"\n";

# case 4
# use MyModule qw(:Both);
# print func1(@list),"\n";
# print func2(@list),"\n";

正如上面所见，我们在MyScript.pl中使用了MyModule。把中间的注释符号都去掉来看看会发生什么。一次都去掉即可。 Case1:因为我们的模块默认什么都没有输出（没有输出&func1和&func2），所以我们会得到一个他们在main:: namespace中不存在的错误。 Case2:这个运行正常。我们让模块输出了&func1,于是我们可以正常使用它。尽管我们没有输出&func2，但是我们使用的是 &func2完整的包路径，所以它也可以正常工作。 Case3:‘:DEFAULT’标签应该输出&func1，所以你应该希望返回一个缺少&func2函数的错误。但事实上perl却偏 偏找上了&func1的麻烦（错误信息提示未定义&func1函数）。恩,这里怎么了呢？原来，DEFAULT这个标签名字是特殊的，在 我们的模块中，%EXPORT_TAGS哈希表它会被自动设置成这样DEFAULT=>\@EXPROT.也就是说，DEFAULT默认导出的是来 自@EXPROT数组的函数。 Case4:我们指定通过‘:Both’标签实现两个函数都输出，他实现了。 *关于@INC的注意事项* 当你提交一个use MyModule的时候，就会指示perl去搜索@INC数组中是否有此模块名。@INC通常包含：

/perl/lib 
/perl/site/lib
.

“.”这个目录表示当前的工作目录。核心模块是安装在perl/lib目录中，非核心模块安装在perl/site/lib目录中。你可以向@INC中添加自定义目录。像下面这样：

BEGIN { push @INC, '/my/dir' }
# or
BEGIN { unshift @INC, '/my/dir' }
# or
use lib '/my/dir';

我们需要使用BEGIN块在编译时向@INC中添加值，此时是perl检查模块的时刻。

如果你等到程序被编译的时候就太晚了，perl会抛出一个异常，说“在@INC中无法找到MyModule”.使用push还是unshift方法 添加值的区别是，perl搜索@INC的顺序是从@INC中的第一个目录开始的。如果你在/perl/lib/、/perl/site/lib/和./中 都有一个MyModule模块的话，那么/perl/lib中的模块将首先被找到并使用。use lib用法可以起到和BEGIN{unshift @INC,$dir}一样的效果－请参看"perlman:lib:lib":http://www.perlmonks.org/?node= perlman%3Alib%3Alib . *use Foo::Bar意味着什么* use Foo::Bar并不意味着在@INC的目录中寻找一个叫做Foo::Bar.pm的模块文件。它的意思是在@INC的目录中寻找一个叫做‘Foo’的 “子目录”，然后在其中找一个叫做“Bar.pm”的“模块”。 现在，如果我们成功"use"了一个模块，那么我们就可以通过完整的包路径语法&PACKAGE::FUNCTION使用这个模块中的所有函数。 当我们说&Foo::Bar::some_func的时候，我们指的是“包的名字”而不是那个在use中曾使用的包含路径的文件名。这会允许你可 以在一个use过的文件中包含很多包名字。实际使用中这些名字通常是相同的。

use warnings;

你应该打开warnings来检测你的模块，因为它可以检测出很多细微的错误。你可以通过在测试模块代码中添加-w参数来打开警告选项。如果你在模 块中添加了use warnings，那么你的模块必须要求运行在perl5.6以上，否则不支持。如果你在模块的顶端添加了$^W++，那么你将会在全局范围内打开警告选 项－这将影响到其他模块，你最好只在你自己的程序中这么使用，因为这略显霸道了一些。这有一个专家写的叫做"tye":http: //www.perlmonks.org/?node=tye 的代码来测试警告选项，但没有直接将它包含进他/她自己的模块中。 希望这些会讲清楚它是怎样工作的。