[关闭]
@zhongdao 2019-03-14T17:38:54.000000Z 字数 20196 阅读 3392

perl最简实用学习教程


ubuntu 下安装

  1. sudo apt install perl-doc

程序文件

运行

  1. perl progname.pl

文件头

  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;

注释

  1. # 单行注释以#号开头
  1. # 多行注释以等号字母开头 等号结束
  2. =pod
  3. 1;
  4. p
  5. print ;
  6. =cut

变量

变量以$号开头。
合法变量名以英文字母或者下划线起始,后接任意数目的字母、数字或下划线。

变量类型

Perl有三种主要的变量类型:标量、数组和哈希。
Perl has three main variable types: $scalar, @array, and %hash.

标量

标量类型代表单个值:

  1. my $animal = "camel";
  2. my $answer = 42;
  3. my $display = "You have $answer ${animal}s.\n";

如果列出多于一个变量,那么列表必须放在圆括弧里。

  1. my($nose, @eyes, %teeth);

标量类型值可以是字符串、整型或浮点类型,Perl会根据需要自动进行类型转换。

数组

数组类型代表一列值:

  1. my @animals = ("camel", "llama", "owl");
  2. my @numbers = (23, 42, 69);
  3. my @mixed = ("camel", 42, 1.23);

使用:

  1. my $second = $animals[1];
  2. print $animals[0]; # prints "camel"
  3. # size
  4. my $num_animals = @animals;
  5. print "array size: ", scalar(@numbers)," \n";

哈希

哈希类型代表一个键/值对的集合:

  1. my %fruit_color = ("apple", "red", "banana", "yellow");

可以使用空格和“=>”操作符更清晰的定义哈希:

  1. my %fruit_color = (
  2. apple => "red",
  3. banana => "yellow",
  4. );

使用:

  1. $fruit_color{"apple"}; # gives "red"
  2. $fruit_color{apple}; # gives "red"

perldata中有标量、数组和哈希更详细的介绍。 (perldoc perldata).

引用 References

  1. my $array_ref = \@array;
  2. my $hash_ref = \%hash;
  3. my @array_of_arrays = (\@array1, \@array2, \@array3);
  1. # References can be dereferenced by prefixing the appropriate sigil.
  2. my @fruits_array = @$fruits;
  1. print "array content: @$array_ref \n";

总结

$为变量; @为数组; %为哈希;
其中数组 和 哈希 都是用"()”来存储数据或者键值对;取值时则采用[]和{}

逻辑和循环结构

if 逻辑判断

  1. if ( $var ) {
  2. ...
  3. } elsif ( $var eq 'bar' ) {
  4. ...
  5. } else {
  6. ...
  7. }
  1. unless ( condition ) {
  2. ...
  3. }

上面这个比"if (!condition)"更可读。

后置逻辑结构

  1. print "Yow!" if $zippy;
  2. print "We have no bananas" unless $bananas;

循环

while

  1. # while
  2. while ( condition ) {
  3. ...
  4. }

for 和 foreach

  1. for ($i = 0; $i <= $max; $i++) {
  2. ...
  3. }
  1. for my $i (0 .. $max) {
  2. print "index is $i";
  3. }
  1. foreach (@array) {
  2. print "This element is $_\n";
  3. }
  1. foreach my $key (keys %hash) {
  2. print $key, ': ', $hash{$key}, "\n";
  3. }

操作比较符

  1. Numeric comparison
  2. == equality
  3. != inequality
  4. < less than
  5. > greater than
  6. <= less than or equal
  7. >= greater than or equal
  8. String comparison
  9. eq equality
  10. ne inequality
  11. lt less than
  12. gt greater than
  13. le less than or equal
  14. ge greater than or equal
  15. Boolean logic
  16. && and
  17. || or
  18. ! not
  19. Miscellaneous
  20. = assignment
  21. . string concatenation
  22. x string multiplication
  23. .. range operator (creates a list of numbers or strings)
  1. $a .= "\n"; # same as $a = $a . "\n";

正则表达式

Perl对正则表达式有深入广泛的支持,perlrequick和perlretut等文档有详细介绍。简单来说:

简单匹配

  1. if (/foo/) { ... } # 如果 $_ 包含"foo"逻辑为真
  2. if ($a =~ /foo/) { ... } # 如果 $a 包含"foo"逻辑为真

简单替换

  1. $a =~ s/foo/bar/; # 将$a中的foo替换为bar
  2. $a =~ s/foo/bar/g; # 将$a中所有的foo替换为bar

一些例子

  1. /^\d+/ string starts with one or more digits
  2. /^$/ nothing in the string (start and end are
  3. adjacent)
  4. /(\d\s){3}/ three digits, each followed by a whitespace
  5. character (eg "3 4 5 ")
  6. /(a.)+/ matches a string in which every odd-numbered
  7. letter is a (eg "abacadaf")
  1. # a cheap and nasty way to break an email address up into parts
  2. if ($email =~ /([^@]+)@(.+)/) {
  3. print "Username is $1\n";
  4. print "Hostname is $2\n";
  5. }

文件和输入输出

可以使用“open()”函数打开文件用于输入输出。

  1. open(my $in, "<", "input.txt") or die "Can't open input.txt: $!";
  2. open(my $out, ">", "output.txt") or die "Can't open output.txt: $!";
  3. open(my $log, ">>", "my.log") or die "Can't open my.log: $!";

可以用"<>"操作符读取一个打开的文件句柄。 在标量语境下会读取一行,在列表环境下会将整个文件读入并将每一行赋给列表的一个元素:

  1. my $line = <$in>;
  2. my @lines = <$in>;

常见于while循环中

  1. while (<$in>) { # assigns each line in turn to $_
  2. print "Just read in this line: $_";
  3. }

子程序

&表示子程序;(通常调用时可以直接写子程序名,也可以加上&程序名)

子程序范例

  1. sub logger {
  2. my $logmessage = shift;
  3. open my $logfile, ">>", "my.log" or die "Could not open my.log: $!";
  4. print $logfile $logmessage;
  5. }
  1. sub square {
  2. my $num = shift;
  3. my $result = $num * $num;
  4. return $result;
  5. }

调用子程序

现在可以像内置函数一样调用子程序:

  1. logger("We have a logger subroutine!");
  1. $sq = square(8);

shift 与 子程序参数 @_

  1. What's that "shift"? Well, the arguments to a subroutine are available to
  2. us as a special array called @_ (see perlvar for more on that). The
  3. default argument to the "shift" function just happens to be @_. So "my
  4. $logmessage = shift;" shifts the first item off the list of arguments and
  5. assigns it to $logmessage.

shift的作用是,子程序的参数是一个数组变量 @_ , shift移动数组中的第一个项,赋予相应变量。

We can manipulate @_ in other ways too:
  1. my ($logmessage, $priority) = @_; # common
  2. my $logmessage = $_[0]; # uncommon, and ugly

子程序参数的复制与修改

  1. @nums = (1.4, 3.5, 6.7);
  2. @ints = int_all(@nums); # 未改变@nums
  3. sub int_all{
  4. my @retlist = @_; # 安全复制
  5. for my $n (@retlist) { $n = int($n) }
  6. return @retlist;
  7. }
  8. print "nums: @nums\n"; # 1.4 3.5 6.7
  9. print "ints: @ints\n"; # 1 3 6
  10. trunc_em(@nums); # 改变了@nums
  11. sub trunc_em {
  12. for (@_) { $_ = int($_) }
  13. }
  14. print "nums: @nums\n"; # 1 3 6

返回数组或哈希

返回数组或哈希的引用

  1. #正常的数组元素访问是 $array[i], 哈希的元素访问时 $hash{element}, 当是reference时,则需要使用$array_ref->[i], 以及 $hash_ref->{element}
  2. my ($array_ref, $hash_ref) = somefunc();
  3. sub somefunc {
  4. my @array = ( 1,2,3);
  5. my %hash = ( 'a' => 1, 'b' => 2, 'c' => 3);
  6. return (\@array, \%hash);
  7. }
  8. print "$array_ref->[1]\n"; # 2
  9. print $hash_ref->{'a'}." \n"; # 1

为了正常使用哈希,需要再做一次转换

  1. my ($hash_ref) = somefunc();
  2. my %hash = %$hash_ref;
  3. sub somefunc {
  4. my %hash = ( 'a' => 1, 'b' => 2, 'c' => 3);
  5. return (\%hash);
  6. }
  7. print join(',',%hash)."\n";

常见缩写

没有指定变量时的默认变量:

  1. <STDIN> 等于 <>
  2. $_ 是很多perl函数的默认变量
  1. while(<>){
  2. print;
  3. }

等同于

  1. while$_ = <STDIN>){
  2. print $_;
  3. }

另外一个例子:

  1. while ( <> ) { eval if !/^#/ }

等同于

  1. while ($_ = <>) { eval $_ if !($_ =~ / ^#/) }

模块 Modules

A module is a set of Perl code, usually subroutines, which can be used
in other Perl code. It is usually stored in a file with the extension
.pm so that Perl can find it.

See perlmod for more details on modules

模块样例

MyModule.pm

  1. package MyModule;
  2. use strict;
  3. use warnings;
  4. sub trim {
  5. my $string = shift;
  6. $string =~ s/^\s+//;
  7. $string =~ s/\s+$//;
  8. return $string;
  9. }
  10. 1; # return 1;

模块调用

  1. use MyModule;
  2. MyModule::trim($string);

使用Perl模块 Modules

  1. my $string = " ok ";
  2. use MyModule;
  3. $string = MyModule::trim($string);
  4. print "string: $string\n";

Perl模块提供一系列特性来帮助你避免重新发明轮子,CPAN是下载模块的好地方( http://www.cpan.org/ )。Perl发行版本身也包含很多流行的模块。

perlfaq有很多常见问题和相应回答,也经常有对优秀CPAN模块的推荐介绍。

对象 Objects

Objects in Perl are just references that know which class (package) they belong to, so that methods (subroutines) called on it can be found there.

对象样例

MyCounter.pm

  1. package MyCounter;
  2. use strict;
  3. use warnings;
  4. sub new {
  5. my $class = shift;
  6. my $self = {count => 0};
  7. return bless $self, $class;
  8. }
  9. sub count {
  10. my $self = shift;
  11. return $self->{count};
  12. }
  13. sub increment {
  14. my $self = shift;
  15. $self->{count}++;
  16. }
  17. 1;

对象调用

  1. use MyCounter;
  2. my $counter = MyCounter->new;
  3. print $counter->count, "\n"; # 0
  4. $counter->increment;
  5. print $counter->count, "\n"; # 1

todo

class & package 中的特定语法

OO Perl
OO Perl is relatively simple and is implemented using references which
know what sort of object they are based on Perl's concept of packages.
However, OO Perl is largely beyond the scope of this document. Read
perlootut and perlobj.

To learn how to install modules you download from CPAN, read
perlmodinstall.

To learn how to use a particular module, use "perldoc Module::Name".
Typically you will want to "use Module::Name", which will then give you
access to exported functions or an OO interface to the module.

TCP Client/Server handling multiple Client(s) connections

https://stackoverflow.com/questions/4856964/perl-tcp-server-handling-multiple-client-connections

https://docstore.mik.ua/orelly/perl2/advprog/ch12_03.htm

https://www.perlmonks.org/?node_id=1089749

select用法

选择RBITS,WBITS,EBITS,TIMEOUT
这将使用指定的位掩码调用select(2)系统调用,可以使用fileno和 vec构建这些位掩码:

https://perldoc.perl.org/functions/select.html

http://www.man7.org/linux/man-pages/man2/select.2.html

参考资料:

Learn X in Y minutes Where X=perl
https://learnxinyminutes.com/docs/perl/
https://learnxinyminutes.com/docs/zh-cn/perl-cn/

X分钟速成Y ,其中 Y=perl
https://www.kancloud.cn/kancloud/learnxinyminutes/58940

perl built-in : perldoc perlintro

常用模块使用

输出中文

同时终端上也配置成中文

  1. my $str="中文";
  2. print FH encode("utf-8",decode("utf-8",$str));

常见变量

$|设置为1, 表示关闭缓冲区。意味着刷新通道;一些web服务器需要这个设置,脚本的输出以及出现在web服务器上。

  1. $| = 1;

eval 捕获运行异常 与 $@

来自最后一个eval的错误

  1. $@
  1. my $json_out = eval { decode_json($json) };
  2. if ($@)
  3. {
  4. print "decode_json failed, invalid json. error:$@\n";
  5. } else {
  6. print " decode ok!\n";
  7. }

字符变量的字节长度

https://perldoc.perl.org/bytes.html

  1. use bytes;
  2. ... chr(...); # or bytes::chr
  3. ... index(...); # or bytes::index
  4. ... length(...); # or bytes::length
  5. ... ord(...); # or bytes::ord
  6. ... rindex(...); # or bytes::rindex
  7. ... substr(...); # or bytes::substr
  8. no bytes;
  1. perldoc -f length
  2. length EXPR
  3. length Returns the length in characters of the value of EXPR. If EXPR is
  4. omitted, returns length of $_. Note that this cannot be used on an
  5. entire array or hash to find out how many elements these have. For
  6. that, use "scalar @array" and "scalar keys %hash" respectively.
  7. Note the characters: if the EXPR is in Unicode, you will get the num-
  8. ber of characters, not the number of bytes. To get the length in
  9. bytes, use "do { use bytes; length(EXPR) }", see bytes.
  1. # 'China' in Simplified Chinese
  2. # 中 国
  3. # Unicode U+4E2D U+56FD
  4. # UTF-8 E4 B8 AD E5 9B BD
  5. sub bytelen {
  6. require bytes;
  7. return bytes::length($_[0]);
  8. }
  9. print length "中国";
  10. print "\n";
  11. print bytelen "中国";
  12. print "\n";
  13. use utf8;
  14. print "after use utf8\n";
  15. print length "中国";
  16. print "\n";
  17. use bytes;
  18. print bytes::length "中国";
  19. print "\n";
  1. 6
  2. 6
  3. after use utf8
  4. 2
  5. 6

设置缺省参数值的一个方法

  1. sub lotsaArgs {
  2. my $arg1 = 'default';
  3. $arg1 = shift if @_;
  4. my $arg2 = 'default';
  5. $arg2 = shift if @_;
  6. my $arg3 = 'default';
  7. $arg3 = shift if @_;
  8. my $arg4 = 'default';
  9. $arg4 = shift if @_;
  10. ...
  11. }

warn & die & Carp 模块

http://www.runoob.com/perl/perl-error-handling.html

warn 函数

warn 函数用于触发一个警告信息,不会有其他操作,输出到STDERR(标准输出文件),通常用于给用户提示:

  1. chdir('/etc') or warn "无法切换目录";

die 函数

die 函数类似于 warn, 但它会执行退出。一般用作错误信息的输出:

  1. chdir('/etc') or die "无法切换目录";

Carp 对比

标准 Carp 模块提供了 warn() 和 die() 函数的替代方法,它们在提供错误定位方面提供更多信息,而且更加友好。当在模块中使用时,错误消息中包含模块名称和行号。

函数名称 类比 作用
carp warn 类似于 warn 函数,通常会将该信息发送到 STDERR
cluck warn 提供了从产生错误处的栈回溯追踪。
croak die croak() 与 die() 一样,可以结束脚本。
confess die confess() 与 die() 类似,但提供了从产生错误处的栈回溯追踪。

confess举例

  1. package T;
  2. require Exporter;
  3. @ISA = qw/Exporter/;
  4. @EXPORT = qw/function/;
  5. use Carp;
  6. sub function {
  7. confess "Error in module!";
  8. }
  9. 1;

在脚本调用以下程序:

  1. use T;
  2. function();

执行以上程序,输出结果为:

  1. Error in module! at T.pm line 9
  2. T::function() called at test.pl line 2

信号SIG与僵尸进程

https://www.jb51.net/article/65715.htm

https://blog.csdn.net/zrm2012/article/details/51955496

[Perl]REAPER:
https://www.jianshu.com/p/7783abbf89f1

https://www.jianshu.com/p/297a0f555918

在linux中的信号,信号其实就是编程里俗称的中断,它使监视与控制其他进程变为有可能。中断信号(signal,又简称为信号)用来通知进程发 生了异步事件。进程之间可以互相通过系统调用kill发送软中断信号。内核也可以因为内部事件而给进程发送信号,通知进程发生了某个事件。注意,信号只是 用来通知某进程发生了什么事件,并不给该进程传递任何数据。

SIG实例代码

Perl 提供了%SIG 这个特殊的默认HASH.调用需要使用到系统保留全局HASH数组%SIG,即使用’$SIG{信号名}’截取信号,相当于,在perl程序中出现这个信 号时,执行我们自己定义某段代码(子函数)的地址值(定义信号响应函数),这代码就是截取这个信息后要执行的结果了。

  1. #!/usr/bin/perl
  2. $SIG{TERM}=$SIG{INT}=\&yoursub;
  3. my $i=1;
  4. while(1){
  5. sleep1;
  6. $i=$i+1;
  7. print$i."\n";
  8. }
  9. sub yoursub{
  10. print" exit ... \n";
  11. exit 0;
  12. }

禁止ctrl+c (ctrl+c 会产生一个INT信号给当前程序) 来关闭当前程序

  1. sub INT_handler {
  2. print("Don't Interrupt!\n");
  3. }
  4. $SIG{'INT'} = 'INT_handler'; #another way is $SIG{'INT'} = \&INT_handler ;
  5. for ($x = 0; $x < 10; $x++) {
  6. print("$x\n");
  7. sleep 1;
  8. }

一个常用的用法使用$SIG{ALRM},设置等待超时一般都这样做:

  1. local $SIG{ALRM} = sub{alarm 0; die "TIMEOUT";};#超时处理过程
  2. eval{
  3. alarm(10);#设定10秒钟后如果下面的代码没处理完,则进入超时处理过程
  4. $input=<>;#处理过程
  5. alarm(0);#如果处理完了,取消超时处理设置
  6. };
  7. if($@=~/TIMEOUT/){ print "time out!\n";}

收割僵死进程 (reaping )

  1. $SIG{CHLD} = 'IGNORE'; ## Children reaped by system
  2. $SIG{CHLD} = 'DEFAULT'; ## System defined
  3. $SIG{CHLD} = &REAPER; ## do REAPER if SIGCHLD catched

当一个进程退出的时候,内核向它的父进程发送一个 CHLD 信号然后该进程就成为一个僵死进程(zombie,注:这是一个技术术语),直到父进程调用 wait 或者 waitpid。如果你在 Perl 里面启动新进程用的不是 fork,那么 Perl 就会替你收割这些僵死进程,但是如果你用的是一个 fork,那么就得自己做清理工作。在许多(但不是全部)内核上,自动收割的最简单办法就是把 $SIG{CHLD} 设置为 'IGNORE'。

  1. $SIG{CHLD} = 'IGNORE';

另一个更简单(但也更乏味)的方法是你自己收割它们。因为在你开始处理的时候,可能有不止一个子进程已经完蛋了,所以,你必须在一个循 环里收割你的子进程直到没有更多为止:

  1. use POSIX ":sys_wait_h";
  2. sub REAPER {
  3. 1 until waitpid(-1, WNOHANG) == -1)
  4. }

想根据需要运行这些代码,你要么可以给它设置 CHLD 信号:

  1. $SIG{CHLD} =\&REAPER;

杀死所有子进程

有时我们要杀死所有的子进程,需要用到向进程组发送信息

  1. {
  2. local$SIG{HUP}='IGNORE';# 排除自己
  3. kill(HUP,-$$);#通知自己的进程组
  4. }

socket 套接字

http://www.runoob.com/perl/perl-socket-programming.html

image_1ch81l86t18m01j3ju1g1v6u1gn29.png-65.4kB

套接字编程样例

  1. #!/usr/bin/perl -w
  2. use strict;
  3. use Socket; # For constants like AF_INET and SOCK_STREAM
  4. use IO::Select;
  5. $| = 1;
  6. my($proto, $port , $sock , $s , @ready , $so , $addrinfo , $client , $inp);
  7. $proto = getprotobyname('tcp'); #get the tcp protocol
  8. # 1. create a socket handle (descriptor)
  9. socket($sock, AF_INET, SOCK_STREAM, $proto)
  10. or die "could not create socket : $!";
  11. # 2. bind to local port
  12. $port = $ARGV[0];
  13. bind($sock , sockaddr_in($port, INADDR_ANY))
  14. or die "bind failed : $!";
  15. listen($sock , 10);
  16. print "Server is now listening ...\n";
  17. #accept incoming connections and talk to clients
  18. $s = IO::Select->new();
  19. $s->add($sock);
  20. while(1)
  21. {
  22. @ready = $s->can_read(0);
  23. foreach $so(@ready)
  24. {
  25. #new connection read
  26. if($so == $sock)
  27. {
  28. my($client);
  29. $addrinfo = accept($client , $sock);
  30. my($port, $iaddr) = sockaddr_in($addrinfo);
  31. my $name = gethostbyaddr($iaddr, AF_INET);
  32. print "Connection accepted from $name : $port \n";
  33. #send some message to the client
  34. send($client , "Hello client how are you\n" , 0);
  35. $s->add($client);
  36. }
  37. # existing client read
  38. else
  39. {
  40. chop($inp = <$so>);
  41. chop($inp);
  42. print "Received -- $inp \n";
  43. my $back = processclient($inp);
  44. send($so, "replay: $back \n",0);
  45. }
  46. }
  47. }
  48. #close the socket
  49. close($sock);
  50. exit(0);
  51. sub processclient {
  52. my $input = shift;
  53. if ($input eq "xxx" ){
  54. my $filename = "file54M.dat.torrent";
  55. my @result = readpipe("curl -s http://localhost:2780/ |grep $filename -A 2 | awk \'{ FS=\">\"; print \$NF }\'");
  56. print $result[-1];
  57. return $result[-1];
  58. } else {
  59. return "not!\n";
  60. }
  61. }

调用

  1. telnet localhost 8888
  2. input
  3. OK: input
  4. xxx
  5. OK: 100%

http server daemon

  1. use HTTP::Daemon;
  2. use HTTP::Status;
  3. my $d = HTTP::Daemon->new(LocalAddr => 'localhost', LocalPort => '8080') || die;
  4. print "Please contact me at: <URL:", $d->url, ">\n";
  5. while (my $c = $d->accept) {
  6. while (my $r = $c->get_request) {
  7. if ($r->method eq 'POST' and $r->uri->path eq "/pass") {
  8. use JSON;
  9. use Data::Dumper;
  10. my $json = decode_json($r->content);
  11. print Dumper $json;
  12. my $response = HTTP::Response->new(200);
  13. $response->content("html result test!");
  14. $c->send_response($response);
  15. }elsif ($r->method eq 'GET' and $r->uri->path eq "/pass2") {
  16. # remember, this is *not* recommended practice :-)
  17. $c->send_file_response("/etc/passwd");
  18. }else {
  19. $c->send_error(RC_FORBIDDEN)
  20. }
  21. }
  22. $c->close;
  23. undef($c);
  24. }

客户端调用:

  1. curl -H "Content-Type: application/json" -X POST --data '{"userID":10001}' http://localhost:8080/pass

又一个http server例子

  1. #!/usr/bin/env perl -s -wl
  2. use strict;
  3. use HTTP::Daemon;
  4. use HTTP::Headers;
  5. use HTTP::Response;
  6. sub help {
  7. print "$0 -port=<port-number>";
  8. }
  9. our $port;
  10. our $addr = "localhost";
  11. $port = 9000 unless defined $port;
  12. my $server = HTTP::Daemon->new(
  13. LocalAddr => $addr,
  14. LocalPort => $port,
  15. Listen => 1,
  16. Reuse => 1,
  17. );
  18. die "$0: Could not setup server" unless $server;
  19. print "$0: http://$addr:$port Accepting clients";
  20. while (my $client = $server->accept()) {
  21. print "$0: Client received";
  22. $client->autoflush(1);
  23. my $request = $client->get_request;
  24. print "$0: Client's Request Received";
  25. print "$0: Request: " . $request->method;
  26. if ($request->method eq 'GET') {
  27. my $header = HTTP::Headers->new;
  28. $header->date( time );
  29. $header->server("$0");
  30. $header->content_type('text/html');
  31. my $content = "<!doctype html><html><head><title>Hello World</title></head><body><h1>Hello World!</h1></body></html>";
  32. my $response = HTTP::Response->new(200);
  33. $response->content($content);
  34. $response->header("Content-Type" => "text/html");
  35. $client->send_response($response);
  36. }
  37. print "$0: Closed";
  38. $client->close;
  39. undef($client);
  40. }

install

  1. wget https://cpan.metacpan.org/authors/id/G/GA/GAAS/HTTP-Daemon-6.01.tar.gz
  2. tar -zxvf HTTP-Daemon-6.01.tar.gz
  3. cd HTTP-Daemon-6.01
  4. sudo perl Makefile.PL
  5. sudo make
  6. sudo make install

http Get & Post

https://blog.csdn.net/hardworkba/article/details/41383577

Get

  1. use LWP::UserAgent;
  2. my $ua = LWP::UserAgent->new;
  3. my $server_endpoint = "http://192.168.1.1:8000/service";
  4. # set custom HTTP request header fields
  5. my $req = HTTP::Request->new(GET => $server_endpoint);
  6. $req->header('content-type' => 'application/json');
  7. $req->header('x-auth-token' => 'kfksj48sdfj4jd9d');
  8. my $resp = $ua->request($req);
  9. if ($resp->is_success) {
  10. my $message = $resp->decoded_content;
  11. print "Received reply: $message\n";
  12. }
  13. else {
  14. print "HTTP GET error code: ", $resp->code, "\n";
  15. print "HTTP GET error message: ", $resp->message, "\n";
  16. }

Post

  1. use LWP::UserAgent;
  2. my $ua = LWP::UserAgent->new;
  3. my $server_endpoint = "http://192.168.1.1:8000/service";
  4. # set custom HTTP request header fields
  5. my $req = HTTP::Request->new(POST => $server_endpoint);
  6. $req->header('content-type' => 'application/json');
  7. $req->header('x-auth-token' => 'kfksj48sdfj4jd9d');
  8. # add POST data to HTTP request body
  9. my $post_data = '{ "name": "Dan", "address": "NY" }';
  10. $req->content($post_data);
  11. my $resp = $ua->request($req);
  12. if ($resp->is_success) {
  13. my $message = $resp->decoded_content;
  14. print "Received reply: $message\n";
  15. }
  16. else {
  17. print "HTTP POST error code: ", $resp->code, "\n";
  18. print "HTTP POST error message: ", $resp->message, "\n";
  19. }

install

  1. wget https://cpan.metacpan.org/authors/id/O/OA/OALDERS/HTTP-Message-6.18.tar.gz
  2. tar -zxvf HTTP-Message-6.18.tar.gz
  3. cd HTTP-Message-6.18
  4. sudo perl Makefile.PL
  5. sudo make
  6. sudo make install

如何避免关闭TCP连接时的地址占用问题

Bind: Address Already in Use
Or How to Avoid this Error when Closing TCP Connections
https://hea-www.harvard.edu/~fine/Tech/addrinuse.html

Hostname

  1. use strict;
  2. use warnings;
  3. use Socket;
  4. use Sys::Hostname;
  5. my $host=hostname;
  6. print "Host name: ".$host."\n";
  7. my $name=gethostbyname($host);
  8. my $ip= inet_ntoa($name);
  9. print $ip."\n";
  10. my $remoteHost= gethostbyname("baidu.com");
  11. my $remoteIp= inet_ntoa($remoteHost);
  12. print $remoteIp,"\n";

process

执行一个程序,以及传入相应参数

  1. $datadir="/root/test";
  2. chdir($datadir) or warn "无法切换目录";
  3. system("pwd");
  4. #$param = "-x /root/test/file11M.dat.torrent";
  5. $param = "-x ~/test/file11M.dat.torrent ";
  6. $param = "-x file11M.dat.torrent ";
  7. system("ctorrent $param");

获取system的执行结果到变量

  1. my $filename = "file54M.dat.torrent";
  2. my @result = readpipe("curl -s http://localhost:2780/ |grep $filename -A 2 | awk \'{ FS=\">\"; print \$NF }\'");
  3. print @result;

通过子程序执行

  1. $param = " /root/test/file11M.dat.torrent";
  2. if(!defined($pid = fork())) {
  3. # fork 发生错误返回 undef
  4. die "无法创建子进程: $!";
  5. }elsif ($pid == 0) {
  6. print "通过子进程输出\n";
  7. exec("ctorrent $param") || die "无法输出日期: $!";
  8. } else {
  9. # 在父进程中
  10. print "通过父进程输出\n";
  11. $ret = waitpid($pid, 0);
  12. print "完成的进程ID: $ret\n";
  13. }
  14. 1;

Json

JSON 教程
http://wiki.jikexueyuan.com/project/json/overview.html

http://wiki.jikexueyuan.com/project/json/with-perl.html

https://www.tutorialspoint.com/json/json_perl_example.htm

https://metacpan.org/pod/release/MAKAMAKA/JSON-2.53/lib/JSON.pm

Function Comments
encode_json 把perl的哈希或数组引用的数据结构转变成 utf8编码的json
decode_json 把utf8编码的json文本编码成perl的hash或数组引用结构
  1. use JSON; # imports encode_json, decode_json, to_json and from_json.
  2. # simple and fast interfaces (expect/generate UTF-8)
  3. $utf8_encoded_json_text = encode_json $perl_hash_or_arrayref;
  4. $perl_hash_or_arrayref = decode_json $utf8_encoded_json_text;
  5. # The function call is functionally identical to:
  6. $json_text = JSON->new->utf8->encode($perl_scalar);
  7. $perl_scalar = JSON->new->utf8->decode($json_text);

install

  1. wget https://cpan.metacpan.org/authors/id/I/IS/ISHIGAKI/JSON-2.97001.tar.gz
  2. tar -zxvf JSON-2.97001.tar.gz
  3. cd JSON-2.97001
  4. sudo perl Makefile.PL
  5. sudo make
  6. sudo make install
  1. wget https://cpan.metacpan.org/authors/id/M/MA/MAKAMAKA/JSON-2.53.tar.gz
  2. $tar xvfz JSON-2.53.tar.gz
  3. $cd JSON-2.53
  4. $perl Makefile.PL
  5. $make
  6. $make install

example

  1. #!/usr/bin/perl
  2. use JSON;
  3. my %rec_hash = ('a' => 1, 'b' => 2, 'c' => 3, 'd' => 4, 'e' => 5);
  4. my $json = encode_json \%rec_hash;
  5. print "$json\n";

字节及 pack && unpack

https://perldoc.perl.org/perlpacktut.html

https://blog.csdn.net/fireroll/article/details/10942217

https://blog.csdn.net/eroswang/article/details/2032564

https://blog.csdn.net/zhaoyangjian724/article/details/53791403

pack && unpack defination

The pack function converts values to a byte sequence containing representations according to a given specification, the so-called "template" argument.
unpack is the reverse process, deriving some values from the contents of a string of bytes.

pack函数把值按照给定的规格模板参数转换成字节序。
unpack是相反过程,把字节序反向导出相应的值。

常见的大小端字节序,字节长度与消息

  1. my $msg = "a";
  2. # length_msg in big endian , n for 16 bit and N for 32 bit integers. (length_msg . msg);
  3. use bytes;
  4. # 编码为大端字节序的长度和消息本身
  5. my $buf = pack( 'N', bytes::length( $msg ) ). $msg;
  6. # 解码大端字节序的长度和消息本身
  7. my @data = unpack 'NA*', $buf;
  1. $foo = pack("s2",1,2);
  2. # "\001\000\002\000" on little-endian
  3. # "\000\001\000\002" on big-endian

字符,字节与encode_json, decode_json

  1. 字符<-decode_json<-字节
  2. 字符->encode_json->字节
  3. 字节 -> decode ->字符串 ->encode ->字节
  4. $response->decoded_content是字符
  5. $response->content是字节
  6. 字符<-decode_json<-字节
  7. 字符->encode_json->字节
  1. my $str = "xxxxbbbb";
  2. my @arr=unpack("x4A*",$str); #略过头4个字节
  3. print $arr[0]; # 打印bbbb

perl modules 安装汇总

安装方法1

HTTP::Request

  1. wget https://cpan.metacpan.org/authors/id/O/OA/OALDERS/HTTP-Message-6.18.tar.gz
  2. tar -zxvf HTTP-Message-6.18.tar.gz
  3. cd HTTP-Message-6.18
  4. sudo perl Makefile.PL
  5. sudo make
  6. sudo make install

安装方法2

  1. # 无需提示,自动安装cpanm
  2. export PERL_MM_USE_DEFAULT=1
  3. cpan App::cpanminus
  4. cpanm HTTP::Daemon
  5. cpanm JSON
  6. cpanm LWP::UserAgent

删除包的方法

https://www.perl.com/article/3/2013/3/27/How-to-cleanly-uninstall-a-Perl-module/
https://stackoverflow.com/questions/7777252/uninstall-all-perl-modules-installed-by-cpan

  1. apt install libcpanplus-perl
  1. # uninstall_perl_module.pl from PerlTricks.com
  2. use 5.14.2;
  3. use ExtUtils::Installed;
  4. use ExtUtils::Packlist;
  5. # Exit unless a module name was passed
  6. die ("Error: no Module::Name passed as an argument. E.G.\n\t perl $0 Module::Name\n") unless $#ARGV == 0;
  7. my $module = shift @ARGV;
  8. my $installed_modules = ExtUtils::Installed->new;
  9. # iterate through and try to delete every file associated with the module
  10. foreach my $file ($installed_modules->files($module)) {
  11. print "removing $file\n";
  12. unlink $file or warn "could not remove $file: $!\n";
  13. }
  14. # delete the module packfile
  15. my $packfile = $installed_modules->packlist($module)->packlist_file;
  16. print "removing $packfile\n";
  17. unlink $packfile or warn "could not remove $packfile: $!\n";
  18. # delete the module directories if they are empty
  19. foreach my $dir (sort($installed_modules->directory_tree($module))) {
  20. print("removing $dir\n");
  21. rmdir $dir or warn "could not remove $dir: $!\n";
  22. }
  1. for module in $(perldoc -t perllocal | grep "Module" | cut -d\" -f3);
  2. do
  3. echo $module
  4. #cpanp uninstall $module
  5. perl uninstall_perl_module.pl $module
  6. done
添加新批注
在作者公开此批注前,只有你和作者可见。
回复批注