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

There's more than one way to do it!
https://metacpan.org http://perlmonks.org
头像
523066680
Administrator
Administrator
帖子: 479
注册时间: 2016年07月19日 12:14
拥有现金: 锁定
储蓄: 锁定
Has thanked: 52 times
Been thanked: 92 times
联系:

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

帖子 #1 523066680 » 2019年06月02日 14:47

某平台订单记录,因为在线获取的记录每一页都有重复的部分,所以代码就长了一些,要判断重叠。
每次执行会叠加更新数据,保存为 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;

回到 “Perl”

在线用户

用户浏览此论坛: 没有注册用户 和 1 访客