A sample use perl www library

清华大佬耗费三个月吐血整理的几百G的资源,免费分享!....>>>

#!/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',
		qd => '2016-02-06',
		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->{from_station_name},
				$ticket->{to_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 (/\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' });

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