perl - 使用 Perl 抓取网站

Question

我有兴趣编写一个转到以下链接并提取数字 1975 的 perl 脚本：https ://familysearch.org/search/collection/results#count=20&query=%2Bevent_place_level_1%3ACalifornia%20%2Bevent_place_level_2%3A%22San %20迭戈%22%20%2Bbirth_year%3A1923-1923~%20%2Bgender%3AM%20%2Brace%3AWhite&collection_id=2000219

该网站是 1923 年出生的白人男性的数量，他们于 1940 年居住在加利福尼亚州圣地亚哥县。我试图在循环结构中做到这一点，以概括多个县和出生年份。

在文件 locations.txt 中，我放置了县列表，例如圣地亚哥县。

当前代码运行，但不是#1975，而是显示未知。数字 1975 应该在 $val\n 中。

我将非常感谢任何帮助！

#!/usr/bin/perl

use strict;

use LWP::Simple;

open(L, "locations26.txt");

my $url = 'https://familysearch.org/search/collection/results#count=20&query=%2Bevent_place_level_1%3A%22California%22%20%2Bevent_place_level_2%3A%22%LOCATION%%22%20%2Bbirth_year%3A%YEAR%-%YEAR%~%20%2Bgender%3AM%20%2Brace%3AWhite&collection_id=2000219';

open(O, ">out26.txt");
 my $oldh = select(O);
 $| = 1;
 select($oldh);
 while (my $location = <L>) {
     chomp($location);
     $location =~ s/ /+/g;
      foreach my $year (1923..1923) {
                 my $u = $url;
                 $u =~ s/%LOCATION%/$location/;
                 $u =~ s/%YEAR%/$year/;
                 #print "$u\n";
                 my $content = get($u);
                 my $val = 'unknown';
                 if ($content =~ / of .strong.([0-9,]+)..strong. /) {
                         $val = $1;
                 }
                 $val =~ s/,//g;
                 $location =~ s/\+/ /g;
                 print "'$location',$year,$val\n";
                 print O "'$location',$year,$val\n";
         }
     }

更新：API 不是一个可行的解决方案。我一直在与网站开发人员联系。API 不适用于网页的该部分。因此，任何与 JSON 有关的解决方案都将不适用。

score 8 · Accepted Answer

您的数据似乎是由 Javascript 生成的，因此 LWP 无法帮助您。也就是说，您感兴趣的网站似乎有一个开发者 API：https ://familysearch.org/developers/

我建议使用Mojo::URL来构造您的查询，并使用Mojo::DOM或Mojo::JSON来分别解析 XML 或 JSON 结果。当然其他模块也可以，但是这些工具集成得非常好，可以让你快速上手。

score 6 · Accepted Answer

您可以使用 WWW::Mechanize::Firefox 来处理任何可以被 Firefox 加载的站点。

http://metacpan.org/pod/WWW::Mechanize::Firefox::Examples

您必须安装 Mozrepl 插件，您将能够通过此模块处理网页内容。基本上，您将“远程控制”浏览器。

这是一个例子（也许工作）

use strict;
use warnings;
use WWW::Mechanize::Firefox;

my $mech = WWW::Mechanize::Firefox->new(
    activate => 1, # bring the tab to the foreground
);
$mech->get('https://familysearch.org/search/collection/results#count=20&query=%2Bevent_place_level_1%3ACalifornia%20%2Bevent_place_level_2%3A%22San%20Diego%22%20%2Bbirth_year%3A1923-1923~%20%2Bgender%3AM%20%2Brace%3AWhite&collection_id=2000219',':content_file' => 'main.html');

my $retries = 10;
while ($retries-- and ! $mech->is_visible( xpath => '//*[@class="form-submit"]' )) {
      print "Sleep until we find the thing\n";
      sleep 2;
};
die "Timeout" if 0 > $retries;
#fill out the search form
my @forms = $mech->forms();
#<input id="census_bp" name="birth_place" type="text" tabindex="0"/>    
#A selector prefixed with '#' must match the id attribute of the input. A selector prefixed with '.' matches the class attribute. A selector prefixed with '^' or with no prefix matches the name attribute.
$mech->field( birth_place => 'value_for_birth_place' );
# Click on the submit
$mech->click({xpath => '//*[@class="form-submit"]'});

score 5 · Accepted Answer

如果您使用浏览器的开发工具，您可以清楚地看到您链接到的页面用于获取您要查找的数据的 JSON 请求。

这个程序应该做你想做的。我添加了一堆注释以提高可读性和解释性，并进行了一些其他更改。

use warnings;
use strict;
use LWP::UserAgent;
use JSON;
use CGI qw/escape/;

# Create an LWP User-Agent object for sending HTTP requests.
my $ua = LWP::UserAgent->new;

# Open data files
open(L, 'locations26.txt') or die "Can't open locations: $!";
open(O, '>', 'out26.txt') or die "Can't open output file: $!";

# Enable autoflush on the output file handle
my $oldh = select(O);
$| = 1;
select($oldh);

while (my $location = <L>) {
    # This regular expression is like chomp, but removes both Windows and
    # *nix line-endings, regardless of the system the script is running on.
    $location =~ s/[\r\n]//g;
    foreach my $year (1923..1923) {
        # If you need to add quotes around the location, use "\"$location\"".
        my %args = (LOCATION => $location, YEAR => $year);

        my $url = 'https://familysearch.org/proxy?uri=https%3A%2F%2Ffamilysearch.org%2Fsearch%2Frecords%3Fcount%3D20%26query%3D%252Bevent_place_level_1%253ACalifornia%2520%252Bevent_place_level_2%253A^LOCATION^%2520%252Bbirth_year%253A^YEAR^-^YEAR^~%2520%252Bgender%253AM%2520%252Brace%253AWhite%26collection_id%3D2000219';
        # Note that values need to be doubly-escaped because of the
        # weird way their website is set up (the "/proxy" URL we're
        # requesting is subsequently loading some *other* URL which
        # is provided to "/proxy" as a URL-encoded URL).
        #
        # This regular expression replaces any ^WHATEVER^ in the URL
        # with the double-URL-encoded value of WHATEVER in %args.
        # The /e flag causes the replacement to be evaluated as Perl
        # code. This way I can look data up in a hash and do URL-encoding
        # as part of the regular expression without an extra step.
        $url =~ s/\^([A-Z]+)\^/escape(escape($args{$1}))/ge;
        #print "$url\n";

        # Create an HTTP request object for this URL.
        my $request = HTTP::Request->new(GET => $url);
        # This HTTP header is required. The server outputs garbage if
        # it's not present.
        $request->push_header('Content-Type' => 'application/json');
        # Send the request and check for an error from the server.
        my $response = $ua->request($request);
        die "Error ".$response->code if !$response->is_success;
        # The response should be JSON.
        my $obj = from_json($response->content);
        my $str = "$args{LOCATION},$args{YEAR},$obj->{totalHits}\n";
        print O $str;
        print $str;
    }
}

score 1 · Accepted Answer

这似乎可以满足您的需求。它不是等待沙漏消失，而是等待 - 更明显的是我认为 - 等待您感兴趣的文本节点的出现。

use 5.010;
use warnings;

use WWW::Mechanize::Firefox;

STDOUT->autoflush;

my $url = 'https://familysearch.org/search/collection/results#count=20&query=%2Bevent_place_level_1%3ACalifornia%20%2Bevent_place_level_2%3A%22San%20Diego%22%20%2Bbirth_year%3A1923-1923~%20%2Bgender%3AM%20%2Brace%3AWhite&collection_id=2000219';

my $mech = WWW::Mechanize::Firefox->new(tab => qr/FamilySearch\.org/, create => 1, activate => 1);
$mech->autoclose_tab(0);

$mech->get('about:blank');
$mech->get($url);

my $text;
while () {
  sleep 1;
  $text = $mech->xpath('//p[@class="num-search-results"]/text()', maybe => 1);
  last if defined $text;
}

my $results = $text->{nodeValue};
say $results;
if ($results =~ /([\d,]+)\s+results/) {
  (my $n = $1) =~ tr/,//d;
  say $n;
}

输出

1-20 of 1,975 results
1975

更新

此次更新特别感谢 @nandhp，他启发我研究以 JSON 格式生成数据的底层数据服务器。

与其通过多余的代码发出请求，不如https://familysearch.org/proxy直接访问服务器https://familysearch.org/search/records，重新编码 JSON 并将所需数据从结果结构中转储出来。这具有速度（请求大约每秒一次 - 比来自基本网站的等效请求快十倍）和稳定性（正如您所注意到的，该站点非常不稳定 - 相比之下我有从未见过使用此方法的错误）。

use strict;
use warnings;

use LWP::UserAgent;
use URI;
use JSON;

use autodie;

STDOUT->autoflush;

open my $fh, '<', 'locations26.txt';
my @locations = <$fh>;
chomp @locations;

open my $outfh, '>', 'out26.txt';

my $ua = LWP::UserAgent->new;

for my $county (@locations[36, 0..2]) {
  for my $year (1923 .. 1926) {
    my $total = familysearch_info($county, $year);
    print STDOUT "$county,$year,$total\n";
    print $outfh "$county,$year,$total\n";
  }
  print "\n";
}

sub familysearch_info {

  my ($county, $year) = @_;

  my $query = join ' ', (
    '+event_place_level_1:California',
    sprintf('+event_place_level_2:"%s"', $county),
    sprintf('+birth_year:%1$d-%1$d~', $year),
    '+gender:M',
    '+race:White',
  );

  my $url = URI->new('https://familysearch.org/search/records');
  $url->query_form(
    collection_id => 2000219,
    count => 20,
    query => $query);

  my $resp = $ua->get($url, 'Content-Type'=> 'application/json');
  my $data = decode_json($resp->decoded_content);

  return $data->{totalHits};
}

输出

San Diego,1923,1975
San Diego,1924,2004
San Diego,1925,1871
San Diego,1926,1908

Alameda,1923,3577
Alameda,1924,3617
Alameda,1925,3567
Alameda,1926,3464

Alpine,1923,1
Alpine,1924,2
Alpine,1925,0
Alpine,1926,1

Amador,1923,222
Amador,1924,248
Amador,1925,134
Amador,1926,67

score 1 · Accepted Answer

没有这个简单的脚本firefox呢？我对该站点进行了一些调查以了解它是如何工作的，并且我看到了一些JSON带有的请求firebug firefox addon，因此我知道要查询哪个 URL以获取相关内容。这是代码：

use strict; use warnings;
use JSON::XS;
use LWP::UserAgent;
use HTTP::Request;

my $ua = LWP::UserAgent->new();

open my $fh, '<', 'locations2.txt' or die $!;
open my $fh2, '>>', 'out2.txt' or die $!;

# iterate over locations from locations2.txt file
while (my $place = <$fh>) {
    # remove line ending
    chomp $place;
    # iterate over years
    foreach my $year (1923..1925) {
        # building URL with the variables
        my $url = "https://familysearch.org/proxy?uri=https%3A%2F%2Ffamilysearch.org%2Fsearch%2Frecords%3Fcount%3D20%26query%3D%252Bevent_place_level_1%253ACalifornia%2520%252Bevent_place_level_2%253A%2522$place%2522%2520%252Bbirth_year%253A$year-$year~%2520%252Bgender%253AM%2520%252Brace%253AWhite%26collection_id%3D2000219";
        my $request = HTTP::Request->new(GET => $url);
        # faking referer (where we comes from)
        $request->header('Referer', 'https://familysearch.org/search/collection/results');
        # setting expected format header for response as JSON
        $request->header('content_type', 'application/json');

        my $response = $ua->request($request);

        if ($response->code == 200) {
            # this line convert a JSON to Perl HASH
            my $hash = decode_json $response->content;
            my $val = $hash->{totalHits};
            print $fh2 "year $year, place $place : $val\n";
        }
        else {
           die $response->status_line;
        }
    }
}

END{ close $fh; close $fh2; }

score 0 · Accepted Answer

我不知道如何从上述解决方案中发布修改后的代码。

此代码（尚未）正确编译。但是，我已经进行了一些重要的更新，以明确朝着这个方向前进。

我非常感谢有关此更新代码的帮助。我不知道如何发布此代码和此后续操作，以便安抚运行此视线的领主。

它卡在睡眠线上。任何有关如何通过它的建议将不胜感激！

use strict;
use warnings;
use WWW::Mechanize::Firefox;

my $mech = WWW::Mechanize::Firefox->new(
activate => 1, # bring the tab to the foreground
);
$mech->get('https://familysearch.org/search/collection/results#count=20&query=%2Bevent_place_level_1%3ACalifornia%20%2Bevent_place_level_2%3A%22San%20Diego%22%20%2Bbirth_year%3A1923-1923~%20%2Bgender%3AM%20%2Brace%3AWhite&collection_id=2000219',':content_file' => 'main.html', synchronize => 0);

 my $retries = 10;
while ($retries-- and $mech->is_visible( xpath => '//*[@id="hourglass"]' )) {
 print "Sleep until we find the thing\n";
  sleep 2;
 };
 die "Timeout while waiting for application" if 0 > $retries;

# Now the hourglass is not visible anymore

#fill out the search form
my @forms = $mech->forms();
#<input id="census_bp" name="birth_place" type="text" tabindex="0"/>    
#A selector prefixed with '#' must match the id attribute of the input. A selector     prefixed with '.' matches the class attribute. A selector prefixed with '^' or with no     prefix matches the name attribute.
$mech->field( birth_place => 'value_for_birth_place' );
# Click on the submit
$mech->click({xpath => '//*[@class="form-submit"]'});

score 0 · Accepted Answer

您应该在访问字段之前设置当前表单：

“给定一个字段的名称，将其值设置为指定的值。这适用于当前表单（由“form_name（）”或“form_number（）”方法设置或默认为页面上的第一个表单）。 "

$mech->form_name( 'census-search' );
$mech->field( birth_place => 'value_for_birth_place' );

抱歉，我无法尝试此代码，感谢您提出新问题。

perl - 使用 Perl 抓取网站

7 回答 7

Related

Reference