大佬教程收集整理的这篇文章主要介绍了A sample use perl www library，大佬教程大佬觉得挺不错的，现在分享给大家，也给大家做个参考。
@H_
801_0@#!/usr/bin/env perl
use utf8;
use
Strict;
use warnings;
use 5.010001;
use WWW::Mechanize;
use WWW::Mechanize::Image;
use
http:
:response;
use JSON::
Tiny qw(decode_json encode_json
);
$ENV
{PERL_LWP_SSL_VERIFY_HOSTNAM
E} = 0;
binmode STDOUT,":encoding(utf8)";
# '
http://stackoverflow.com/questions/6795030/how-to-ignore-certificate-verify-failed-error-in-perl'
# '
http://htmlparsing.com/per
l.html'
# '
https://metacpan
.org/pod/WWW::Mechanize#mech-put-uri-content-content'
# '
https://metacpan
.org/pod/
http:
:response'
# '
https://metacpan
.org/pod/LWP::UserAgent'
# '
https://metacpan
.org/pod/WWW::Mechanize::Image'
# '
http://www.perlmonk
s.org/?node_id=737473'
# '
http://stackoverflow.com/questions/10648754/how-do-i-simulate-this-particular-post-
request-in-mechanize'
# '
https://kyfw.12306.cn/otn/login/init'
# '
http://
Dict.youdao.com'
my %url = (
'unlogin' =>
{
'init' => '
https://kyfw.12306.cn/otn/login/init','getcode' => '
https://kyfw.12306.cn/otn/passcodeNew/getPassCodeNew?module=login&rand=sjrand&0.9890632561546399','verifycode' => '
https://kyfw.12306.cn/otn/passcodeNew/
checkRandCodeAnsyn','login' => '
https://kyfw.12306.cn/otn/login/loginAysnSuggest',},'logined' =>
{
'login' => '
https://kyfw.12306.cn/otn/login/userLogin','init' => '
https://kyfw.12306.cn/otn/index/initMy12306','queryinit' => '
https://kyfw.12306.cn/otn/lcxxcx/init','logout' => '
https://kyfw.12306.cn/otn/login/loginOut',
);
# query need fill in query data,such as date,from station ..
my $t = '
https://kyfw.12306.cn/otn/lcxxcx/query?purpose_codes=%s&queryDate=%s&from_station=%s&to_station=%s',my %info = (
'account' => '','
password' => '',
);
my %
Train = (
one =>
{
pc => 'ADULT',qd => '2016-02-06',fs => 'BJP',ts => 'JNK',rg => 'G\d+',two =>
{
pc => 'ADULT',fs => 'JNK',ts => 'JIK',rg => '.*',}
);
my @
Train = getquery($t,\%
Train
);
my $curr = undef;
our $localpath = '
password/';
#
#
if (! -e $localpath )
{
mkdir($localpath
);
}
# read
password
{
my $pwdata = slurp($ARGV
[0]);
my $pwj = decode_json($pwdata
);
$info
{passworD} = $pwj->
{passworD};
$info
{account} = $pwj->
{account};
}
#
# may be disconnect because of network..
#
###############################################################
my $mech = mechanize(
);
$mech->get($url
{unlogin}
{init}
);
check($mech->
success(),"can not access homepage."
);
my $localfile = localtime() .".jpg";
downloadImage($url
{unlogin}
{getcod
E},$localfile,$mech
);
my $size = -s $localpath.$localfile; # get picture size
if ($size <= 3 * 10
24) {
check (0,"picture size -> $size . try latter .."
);
}
note("ready input verify code "
);
# input such as 1,1 or 2,3 [cell's coordinate
you want click on picture ] .
my $randcode = randGet(
);
note("Verify Code => ".$randcod
E);
sleep(5
);
note("Post to verify"
);
my $content;
my $res = $mech->post($url
{unlogin}
{verifycod
E},[ 'randCode' => $randcode,'rand' => 'sjrand' ]
);
if ($mech->
success && $res->is_
success)
{
$content = $res->decoded_content;
if ($content =~ /TRUE/)
{
note("verify ok"
);
} else
{
note("verify error -> " . $content
);
check(0," quit"
);
}
} else
{
check(0,"can not get respone"
);
}
sleep(3
);
note ("start login"
);
$res = $mech->post($url
{unlogin}
{login},[ 'loginUserDTO.
user_name' => $info
{account},'userDTO.
password' => $info
{passworD},'randCode' => $randcode ]
);
if ($mech->
success && $res->is_
success)
{
$content = $res->decoded_content;
} else
{
check(0,"can not get respone"
);
}
sleep(3
);
note("login !!"
);
$res = $mech->post($url
{logine
D}{login},[ '_json_attr' => '' ]
);
if ($mech->
success && $res->is_
success)
{
$content = $res->decoded_content;
} else
{
check(0,"can not get respone"
);
}
sleep(3
);
note("init my 12306"
);
$mech->get($url
{logine
D}{init}
);
check($mech->
success(),"can not access ".$url
{logine
D}{init}
);
sleep(3
);
note("init lcxxcx"
);
$mech->get($url
{logine
D}{queryinit}
);
check($mech->
success(),"can not access ".$url
{logine
D}{queryinit}
);
while
(1) {
if (! -e "run.flag")
{
last;
}
if (!defined($curr))
{
$curr = shift @
Train;
} else
{
sleep(5
);
note("query ..."
);
$mech->get($curr
);
check($mech->
success(),"can not access ".$curr
);
my @tickets = gettickets(decode_json($mech->content)
);
say join("\t",("车次","始发","终点","出发","目的","开车","到站","历时","二等座","硬座")
);
for my $ticket (@tickets)
{
say join("\t",(
$ticket->
{station_
Train_cod
E},$ticket->
{start_station_nam
E},$ticket->
{end_station_nam
E},$ticket->
{from_station_nam
E},$ticket->
{to_station_nam
E},$ticket->
{lishi},$ticket->
{'ze_num'},$ticket->
{'yz_num'},)
);
}
}
}
sleep(3
);
note("loginOut"
);
$mech->get($url
{logine
D}{logout}
);
check($mech->
success(),"can not access ".$url
{logine
D}{logout}
);
exit;
#####################################
#$info
{Train} = $term->
{station_
Train_cod
E};
#$info
{start} = $term->
{start_station_nam
E};
#$info
{en
D} = $term->
{end_station_nam
E};
#$info
{from} = $term->
{from_station_nam
E};
#$info
{to} = $term->
{to_station_nam
E};
#$info
{start_tim
E} = $term->
{from_station_nam
E};
#$info
{arrive_tim
E} = $term->
{to_station_nam
E};
#$info
{tim
E} = $term->
{lishi};
#$info
{'seat-g'} = $term->
{'ze_num'};
#$info
{'seat-y'} = $term->
{'yz_num'};
sub gettickets
{
my $json = shift;
if (! $json->
{status})
{
return undef;
}
my $data = $json->
{data};
my @all;
for my $term (@
{$data->
{datas}})
{
push @all,$term;
}
return @all;
}
sub getquery
{
my $template = shift;
my $
Train = shift;
my @all;
for (keys %
{$
Train})
{
my $o = $
Train->
{$_};
my $str = sprintf $t,$o->
{pc},$o->
{q
D},$o->
{fs},$o->
{ts};
push @all,$str;
}
return @all;
}
sub slurp
{
my $file = shift;
open my $fh,'<',$file or die "Open $file failed!";
local $/ = undef;
my $data = <$fh>;
close $fh;
return $data;
}
sub getline
{
while(<STDIN>)
{
chomp;
return $_;
}
}
sub randGet
{
my $verify_code = "";
while (<STDIN>)
{
chomp;
if (/\A\Z/)
{
return $verify_code;
} else
{
if ($verify_code =~ /\A\Z/)
{
$verify_code = point(split(/,/,$_)
);
} else
{
$verify_code = $verify_code . ',' . point(split(/,$_)
);
}
}
}
}
sub point
{
my ($y,$
X) = @_;
my $rx = ($x - 1) * 73 + 36;
my $ry = ($y - 1) * 95 + 47;
return "$rx,$ry";
}
sub downloadImage
{
my ($url,$local,$mech) = @_;
if (!defined($mech))
{
$mech = mechanize(
);
}
if ($url)
{
$mech->get($url,':content_file' => $localpath.$local
);
check($mech->
success(),"can not get image -> ".$url
);
} else
{
check(0,"image is null"
);
}
}
sub mechanize
{
my $mech = WWW::Mechanize->new('ssl_opts' =>
{ 'verify_hostname' => 0,SSL_verify_mode => 'SSL_VERIFY_NONE' }
);
### set
Tings
$mech->agent_alias('Windows Mozilla'
);
return $mech;
}
sub note
{
my $str = shift;
say "+ -> $str";
}
sub
check
{
my ($bool,$msg) = @_;
unless ($bool)
{
print $msg."\n";
exit
(1);
}
}
大佬总结
以上是大佬教程为你收集整理的A sample use perl www library全部内容，希望文章能够帮你解决A sample use perl www library所遇到的程序开发问题。
如果觉得大佬教程网站内容还不错，欢迎将大佬教程推荐给程序员好友。
本图文内容来源于网友网络收集整理提供，作为学习参考使用，版权属于原作者。
如您有任何意见或建议可联系处理。小编QQ：384754419，请注明来意。
