Perl笔记
来自Jack's Lab
目录 |
1 安装
Catalyst:
$ apt-get install perl perl-modules libcatalyst-perl libcatalyst-modules-perl
moduel:
$ apt-get install libdata-random-perl libdatetime-perl libcrypt-cbc-perl libcrypt-des-perl
2 Replace the string in files
$ perl -p -i -e 's/old/new/g;' *.config
or:
$ perl -pi .bak -e 's/old/new/g;' *.config
3 32位位反转
$ cat bit-rev.pl
#!/usr/bin/perl
sub rev
{
my $in = shift;
$in = ($in & 0x55555555) << 1 | ($in & 0xaaaaaaaa) >> 1;
$in = ($in & 0x33333333) << 2 | ($in & 0xCCCCCCCC) >> 2;
$in = ($in & 0x0f0f0f0f) << 4 | ($in & 0xf0f0f0f0) >> 4;
$in = ($in & 0x00ff00ff) << 8 | ($in & 0xff00ff00) >> 8;
$in = ($in & 0x0000ffff) << 16 | ($in & 0xffff0000) >> 16;
return $in;
}
my $d = 0x80008001;
printf "d = 0x%08x\n", $d;
printf "rd = 0x%08x\n", &rev($d);
$ ./bit-rev.pl
d = 0x80008001
rd = 0x80010001
4 进制转换
For bash:
# for bash. your shell is probably different. alias d2h="perl -e 'printf qq|%X\n|, int( shift )'" alias d2o="perl -e 'printf qq|%o\n|, int( shift )'" alias d2b="perl -e 'printf qq|%b\n|, int( shift )'" alias h2d="perl -e 'printf qq|%d\n|, hex( shift )'" alias h2o="perl -e 'printf qq|%o\n|, hex( shift )'" alias h2b="perl -e 'printf qq|%b\n|, hex( shift )'" alias o2h="perl -e 'printf qq|%X\n|, oct( shift )'" alias o2d="perl -e 'printf qq|%d\n|, oct( shift )'" alias o2b="perl -e 'printf qq|%b\n|, oct( shift )'"
5 字符整数转换
# for bash. your shell is probably different. alias d2c="perl -e 'printf qq|%s\n|, chr( shift )'" alias h2c="perl -e 'printf qq|%s\n|, chr(hex shift )'" alias c2d="perl -e 'printf qq|%u\n|, ord( shift )'" alias c2h="perl -e 'printf qq|0x%x\n|, ord( shift )'" --- comcat@jackslab $ d2c 97 a comcat@jackslab $ c2d b 98 comcat@jackslab $ h2c 61 a comcat@jackslab $ h2c 0x61 a comcat@jackslab $ c2h a 0x61 comcat@jackslab $ c2h b 0x62
6 十六进制字符串
$ cat test.pl
#!/usr/bin/perl
my $seed = 0x52536264;
print "seed = " . $seed . "\n";
printf "seed = 0x%x\n", $seed;
# bit revert
$seed = &rev($seed);
printf "seed bit revert = 0x%x\n", $seed;
my $id = sprintf("0x%08x", $seed);
printf "id = %s\n", $id;
printf "decode id = 0x%x\n", &rev(hex $id);
$ ./test.pl
seed = 1381196388
seed = 0x52536264
seed bit revert = 0x2646ca4a
id = 0x2646ca4a
decode id = 0x52536264
7 vec
$ cat test.pl
#!/usr/bin/perl
my $seed = 0x52546264;
my $id = sprintf("%08x", $seed);
printf "id = %s\n", $id;
printf "vec(id, 2, 8) = %u\n", vec($id, 2, 8);
printf "vec(id, 2, 8) = %s\n", chr(vec($id, 2, 8));
$ ./test.pl
id = 52546264
vec(id, 2, 8) = 53
vec(id, 2, 8) = 5
vec 将字符串 "52546264"，8位一个单位，从0开始标号，最左8位为0，其次为1。序号2对应的8位值为 53，此为字符 '5' 的 ASCII 码值
8 HTTP
8.1 Socket
my $body_len = length($body);
my $head = << "EOF";
POST /v1/messages HTTP/1.1
Accept: */*
xkey: XKEY
Content-Length: C_LEN
Content-Type: text/html
BODY
EOF
$head =~ s/XKEY/$xkey/g;
$head =~ s/C_LEN/$body_len/g;
$head =~ s/BODY/$body/g;
use IO::Socket;
my $sock = new IO::Socket::INET (
PeerAddr => 'api.google.com',
PeerPort => '9999',
Proto => 'tcp',
);
die "Could not create socket: $!\n" unless $sock;
print $sock $head;
print while <$sock>;
close ($sock);
8.2 LWP Simple
use LWP::Simple; use JSON; my $content = get "https://api.weixin.qq.com/cgi-bin/token?grant_type=client_credential&appid=APPID&secret=APPSECRET"; die "Couldn't get" unless defined $content; my $tmp = from_json($content); ......
LWP::Simple 的 post 需要额外的包：/usr/share/perl5/LWP/Simple/Post.pm
use LWP::Simple::Post qw(post post_xml);
use JSON;
my $ticket_url = "https://api.weixin.qq.com/cgi-bin/qrcode/create?access_token=TOKEN";
my $req = "{\"action_name\":\"QR_LIMIT_SCENE\",\"action_info\": {\"scene\": {\"scene_id\": $param}}}";
my $ret = post($ticket_url, $req);
my $t = from_json($ret);
8.3 LWP UserAgent
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
$ua->agent("XXL/1.0");
my $req = HTTP::Request->new(POST => 'http://api.google.com:888/v2.0/node');
$req->header(Accept => "*/ *");
$req->header(nodid => "$uuid");
$req->header(token => "$token");
$req->header(type => "x1");
$req->content_type('text/html');
$req->content($body);
my $ret = $ua->request($req);
my $ct = $ret->content;
if ($ret->is_success) {
print STDERR $ct;
} else {
print STDERR $ret->status_line . "\t" . $ct;
}
9 Resource
- Mastering Perl: http://chimera.labs.oreilly.com/books/1234000001527/index.html
- Catalyst Manual: https://metacpan.org/release/Catalyst-Manual
- meta cpan: https://metacpan.org/pod/Data::Random
- perl doc: http://perldoc.perl.org/
