A sample use perl www library

大佬教程收集整理的这篇文章主要介绍了A sample use perl www library，大佬教程大佬觉得挺不错的，现在分享给大家，也给大家做个参考。

#!/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 => '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->@R_450_6048@s(),"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->@R_450_6048@s && $res->is_@R_450_6048@s) {
	$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->@R_450_6048@s && $res->is_@R_450_6048@s) {
	$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->@R_450_6048@s && $res->is_@R_450_6048@s) {
	$content = $res->decoded_content;
} else {
	check(0,"can not get respone");
}

sleep(3);
note("init my 12306");

$mech->get($url{logineD}{init});
check($mech->@R_450_6048@s(),"can not access ".$url{logineD}{init});

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

$mech->get($url{logineD}{queryinit});
check($mech->@R_450_6048@s(),"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->@R_450_6048@s(),"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->@R_450_6048@s(),"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 (/\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->@R_450_6048@s(),"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);
	}
}

大佬总结

以上是大佬教程为你收集整理的A sample use perl www library全部内容，希望文章能够帮你解决A sample use perl www library所遇到的程序开发问题。

如果觉得大佬教程网站内容还不错，欢迎将大佬教程推荐给程序员好友。

本图文内容来源于网友网络收集整理提供，作为学习参考使用，版权属于原作者。
如您有任何意见或建议可联系处理。小编QQ：384754419，请注明来意。