[Perl]爬虫 - 抓取并积累某平台订单记录

[523066680]

某平台订单记录，因为在线获取的记录每一页都有重复的部分，所以代码就长了一些，要判断重叠。
每次执行会叠加更新数据，保存为 perldb 文件，使用 Storable 模块做转储

Code: [全选] [展开/折叠] [Download] (Untitled.pl)

1. =info
2.     爬取订单记录、积累数据
3.     Author: 523066680/vicyang
4.     Date: 2019-03
5.  
6.     方案：获取所有旧数据，获取所有在线数据，将数据合并。
7. =cut
8.  
9. use Modern::Perl;
10. use Encode;
11. use File::Slurp;
12. use Storable;
13. use FindBin;
14. use lib "$FindBin::Bin/../Function";
15. use GetOrders;
16. STDOUT->autoflush(1);
17.  
18. my $item = "2050788225";
19. my $dbfile = "Brief_${item}.perldb";
20.  
21. my $old = get_original( $dbfile );
22. my $online = GetOrders::get_online_orders( $item );
23.  
24. printf "orders in db: %d\n", 1+$#$old;
25. printf "orders online: %d\n", 1+$#$online;
26.  
27. say "Merging";
28. GetOrders::merge( $old, $online );
29. printf "Dumping, items: %d\n", $#$old+1;
30. store $old, $dbfile;
31. say "Done";
32. exit;
33.  
34. sub get_original
35. {
36.     my $dbfile = shift;
37.     my $data = -e $dbfile ? retrieve( $dbfile ) : [];
38.     return $data;
39. }

模块代码（路径 ..\Function\GetOrders.pm）：

Code: [全选] [展开/折叠] [Download] (GetOrders.pm)

1. package GetOrders;
2. use Modern::Perl;
3. use Mojo::UserAgent;
4. use Mojo::DOM;
5. use Date::Parse;
6. use Date::Format;
7.  
8. our $main = "https://feedback.aliexpress.com";
9. our $url = "https://feedback.aliexpress.com/display/evaluationProductDetailAjaxService.htm";
10. our $ua = Mojo::UserAgent->new();
11. our @headers = (
12.         "Host" => "www.aliexpress.com",
13.         "User-Agent" => "Firefox/63.0",
14.     );
15.  
16. sub get_online_orders
17. {
18.     my ($item) = @_;
19.     my $orders = [];
20.     my %args = (
21.         "productId" => $item,
22.         "type" => "default",
23.         "page" => "1"
24.     );
25.  
26.     my $pgcode = 1;
27.     my $total = 1;
28.     my $parts;
29.     my @all;
30.     #　按页码顺序获取，数据存储到 @all
31.     while ( $pgcode <= $total and $pgcode <= 10 )
32.     {
33.         printf "Current Page %d\n", $pgcode;
34.         $args{'page'} = $pgcode;
35.         my $res = $ua->get( $url, form => \%args )->result;
36.         redo unless $res->is_success;
37.         ($parts, $total) = read_json( $res, $pgcode );
38.         # $parts 返回升序序列，但不同页码的时间段是降序，unshift 将其反转。
39.         unshift @all, $parts;
40.         $pgcode++;
41.     }
42.  
43.     # 按日期（升序）合并
44.     grep { merge( $orders, $_ ) } @all;
45.  
46.     return $orders;
47. }
48.  
49. # merge 是可复用函数，可以在外部使用。
50. sub merge
51. {
52.     my ( $orders, $parts ) = @_;
53.     if ( $#$orders < 0 ) {
54.         @$orders = @$parts;
55.     } else {
56.         my $sect = 0;
57.         for my $id ( 0 .. $#$parts-1 ) {
58.             if ( $parts->[$id][0] == $orders->[-2][0]  and
59.                  $parts->[$id+1][0] == $orders->[-1][0] )
60.             {
61.                 $sect = $id+2;
62.                 last;
63.             }
64.         }
65.         #printf "Sect: %d\n", $sect;
66.         push @$orders, @{$parts}[$sect .. $#$parts];
67.     }
68. }
69.  
70. sub read_json
71. {
72.     my ($res, $page) = @_;
73.     my $node = $res->json;
74.     my $data = [];
75.  
76.     # 如果页码不对，返回空数据
77.     return [] if $node->{page}->{current} != $page;
78.     for my $e ( @{$node->{records}} )
79.     {
80.         # 降序反转为升序
81.         unshift @$data, [
82.                 str2time($e->{date}),
83.                 $e->{countryCode},
84.                 $e->{quantity},
85.                 $e->{name},
86.                 $e->{buyerAccountPointLeval},
87.             ];
88.     }
89.    
90.     return ( $data, $node->{page}->{total} );
91. }
92.  
93. 1;