Mojo::UserAgent 批量获取 nes 游戏资源

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

Mojo::UserAgent 批量获取 nes 游戏资源

帖子 #1 523066680 » 2018年12月28日 11:55

http://www.nesfiles.com/Games
每个游戏的详情页可能有些许差异,比如有的有作弊码、秘籍、手册,有的有midi音乐文件,有的没有。
此脚本已经做了判断,并按游戏名目录存储。

  1. =info
  2.     Mojo::UserAgent 批量获取 nes 游戏资源
  3.     523066680/vicyang
  4.     2018-12
  5. =cut
  6.  
  7. use File::Slurp;
  8. use File::Path;
  9. use File::Basename;
  10. use Mojo::UserAgent;
  11. use Mojo::DOM;
  12. use Try::Tiny;
  13. STDOUT->autoflush(1);
  14.  
  15. our $wdir = "F:/temp/nesgames";
  16. our $main = "http://www.nesfiles.com";
  17. our $games = "http://www.nesfiles.com/Games";
  18.  
  19. mkpath $wdir unless -e $wdir;
  20. chdir $wdir;
  21.  
  22. our $ua = Mojo::UserAgent->new();
  23. our @headers = ( "User-Agent" => "Firefox/63.0" );
  24.  
  25. get_games_list($games);
  26.  
  27. sub get_games_list
  28. {
  29.     our $main;
  30.     my ($link) = @_;
  31.     my $res = $ua->get( $link, \@headers )->res;
  32.     my $dom = $res->dom;
  33.  
  34.     for my $e ( $dom->find(".nesfilesTable a")->each )
  35.     {
  36.         #printf "%s %s\n", $e->attr("href"), $e->text;
  37.         get_files( $main .$e->attr("href"), $e->text );
  38.         #exit;
  39.     }
  40. }
  41.  
  42. sub get_files
  43. {
  44.     our $main;
  45.     my ($link, $name) = @_;
  46.     my $title = basename($link);
  47.     my ($res, $dom);
  48.  
  49.     my $fname = "${title}.html";
  50.     if ( -e $fname ) {
  51.         my $html = read_file($fname);
  52.         $dom = Mojo::DOM->new( $html );
  53.     } else {
  54.         $res = $ua->get( $link, \@headers )->res;
  55.         $dom = $res->dom;
  56.         write_file( $fname, {binmode=>":raw"}, $res->body );
  57.     }
  58.  
  59.     # 获取资源明细,略过 Ebay 相关的条目
  60.     mkdir $title unless -e $title;
  61.     my ($head, $list, $res2);
  62.     for my $section ($dom->find(".GameSection")->each)
  63.     {
  64.         $head = $section->at("header")->text;
  65.         last if $head=~/Ebay$/i;
  66.  
  67.         # 秘籍/代码
  68.         if ($head=~/Codes/i) {
  69.             write_file( $title ."/Codes_Cheats.txt", $section->all_text );
  70.             next;
  71.         }
  72.  
  73.         if ($head=~/Screenshots/i) {
  74.             # 如果是屏幕截图
  75.             $list = $section->find("img")->map(attr=>"src");
  76.         } else {
  77.             # 其他情况获取 href
  78.             $list = $section->find("a")->map(attr=>"href");
  79.         }
  80.  
  81.         printf "%s\n", $head;
  82.         for my $href ( $list->each )
  83.         {
  84.             printf "%s\n", $href;
  85.             $fname = $title ."/". basename($href);
  86.            
  87.             next if -e $fname;         # 跳过已经存在的文件
  88.             $res2 = try_to_get( "${main}$href" );
  89.             next unless defined $res2; # 如果获取失败
  90.  
  91.             write_file( $fname, {binmode=>":raw"}, $res2->body);
  92.         }
  93.     }
  94. }
  95.  
  96. sub try_to_get
  97. {
  98.     our ($ua);
  99.     my ($link) = @_;
  100.     my $res;
  101.     my $times = 0;
  102.  
  103.     while (1)
  104.     {
  105.         try { $res = $ua->get( $link )->result; }
  106.         catch { printf "Error %s, retry: %d\n", $_, $times; };
  107.         $times++;
  108.         last if (defined $res and $res->is_success);
  109.         return undef if ( $times > 5 );
  110.     }
  111.     return $res;
  112. }

回到 “Perl”

在线用户

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