A sample use perl www library

以下代码由PHP站长网 52php.cn收集自互联网

现在PHP站长网小编把它分享给大家，仅供参考

#!/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_HOSTNAME} = 0;
binmode STDOUT,":encoding(utf8)";

# 'http://stackoverflow.com/questions/6795030/how-to-ignore-certificate-verify-failed-error-in-perl'
# 'http://htmlparsing.com/perl.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.perlmonks.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 => 'Gd+',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}{getcode},$localfile,$mech);

my $size = -s $localpath.$localfile; # get picture size

if ($size <= 3 * 1024) {
	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 => ".$randcode);

sleep(5);
note("Post to verify");

my $content;
my $res = $mech->post($url{unlogin}{verifycode},[ '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{logined}{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{logined}{init});
check($mech->success(),"can not access ".$url{logined}{init});

sleep(3);
note("init lcxxcx");

$mech->get($url{logined}{queryinit});
check($mech->success(),"can not access ".$url{logined}{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_code},$ticket->{start_station_name},$ticket->{end_station_name},$ticket->{from_station_name},$ticket->{to_station_name},$ticket->{lishi},$ticket->{'ze_num'},$ticket->{'yz_num'},));
		}
	}
}

sleep(3);
note("loginOut");

$mech->get($url{logined}{logout});
check($mech->success(),"can not access ".$url{logined}{logout});

exit;

#####################################

#$info{train} = $term->{station_train_code};
#$info{start} = $term->{start_station_name};
#$info{end}   = $term->{end_station_name};
#$info{from} = $term->{from_station_name};
#$info{to}   = $term->{to_station_name};
#$info{start_time} = $term->{from_station_name};
#$info{arrive_time} = $term->{to_station_name};
#$info{time} = $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->{qd},$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 (/AZ/) {
			return $verify_code;
		} else {
			if ($verify_code =~ /AZ/) {
				$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' });

	### settings
	$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);
	}
}

以上内容由PHP站长网【52php.cn】收集整理供大家参考研究

如果以上内容对您有帮助，欢迎收藏、点赞、推荐、分享。

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!