使用Perl来抓取一个网站

时间：2013-02-01 20:16:06

标签： perl web-scraping

我有兴趣编写一个perl脚本，该脚本转到以下链接并提取数字1975：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

该网站是1923年出生于加利福尼亚州圣地亚哥县的1923年出生的白人人数。我试图以循环结构来实现这一目标，以概括多个县和出生年份。

在文件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相关的解决方案都不适用。

7 个答案:

答案 0 :(得分：8)

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

我建议使用Mojo::URL构建查询，并使用Mojo::DOM或Mojo::JSON分别解析XML或JSON结果。当然，其他模块也可以使用，但这些工具集成得很好，让您快速入门。

答案 1 :(得分：6)

您可以使用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"]'});

答案 2 :(得分：4)

如果您使用浏览器的开发工具，您可以清楚地看到您链接到的页面用于获取您正在寻找的数据的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;
    }
}

答案 3 :(得分：1)

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

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并从生成的结构中转储所需的数据。这有两个速度的优势（请求大约每秒一次 - 比基本网站的同等请求快10倍）和稳定性（如你所知，网站非常脆弱 - 相比之下我有从未见过使用此方法的错误。）

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

答案 4 :(得分：1)

没有firefox的简单脚本怎么样？我对该网站进行了一些调查，以了解它是如何工作的，我看到JSON firebug firefox addon个请求，因此我知道哪个URL to query为得到相关的东西。这是代码：

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

答案 5 :(得分：0)

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

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

我非常感谢有关此更新代码的帮助。我不知道如何发布这个代码，这样跟进，以便安抚那些运行此视线的领主。

它陷入了睡眠线。关于如何通过它的任何建议将不胜感激！

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"]'});

答案 6 :(得分：0)

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

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

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

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

相关问题
最新问题