perl - Perl を使用して Web サイトをスクレイピングする

Question

次のリンクにアクセスして 1975 という数字を抽出する perl スクリプトを書くことに興味があります: %20Diego%22%20%2Bbirth_year%3A1923-1923~%20%2Bgender%3AM%20%2Brace%3AWhite&collection_id=2000219

そのウェブサイトは、1940 年にカリフォルニア州サンディエゴ郡に住む 1923 年生まれの白人男性の数です。ループ構造でこれを実行して、複数の郡と誕生年を一般化しようとしています。

ファイル location.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 は Web ページのその部分には適用されません。したがって、JSON に関連するソリューションは適用されません。

Answer 1

データが Javascript によって生成されているように見えるため、LWP は役に立ちません。そうは言っても、あなたが興味を持っているサイトには開発者 API があるようです: https://familysearch.org/developers/

Mojo::URLを使用してクエリを作成し、Mojo::DOMまたはMojo::JSONを使用してそれぞれ XML または JSON の結果を解析することをお勧めします。もちろん、他のモジュールも機能しますが、これらのツールは非常にうまく統合されており、すぐに使い始めることができます。

Answer 2

WWW::Mechanize::Firefox を使用して、Firefox でロードできるすべてのサイトを処理できます。

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

Mozrepl プラグインをインストールする必要があり、このモジュールを介して Web ページのコンテンツを処理できるようになります。基本的に、ブラウザを「リモートで制御」します。

これが例です（おそらく機能しています）

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

Answer 3

ブラウザの開発ツールを使用すると、リンク先のページが探しているデータを取得するために使用する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;
    }
}

Answer 4

のないこの単純なスクリプトはfirefoxどうですか? JSONサイトがどのように機能するかを理解するためfirebug firefox addonにサイトを少し調査したところ、. コードは次のとおりです。

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

Answer 5

これはあなたが必要とすることをするようです。砂時計が消えるのを待つ代わりに、興味のあるテキストノードが現れるのを待ちます - もっと明白だと思います.

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

---

アップデート

この更新は、JSON 形式でデータを生成する基盤となるデータ サーバーに注目するきっかけをくれた @nandhp に特に感謝しています。

このコードは余分な方法でリクエストを行うのではなく、https://familysearch.org/proxyでサーバーに直接アクセスしhttps://familysearch.org/search/records、JSON を再エンコードして、結果の構造から必要なデータをダンプします。これには、速度 (リクエストは 1 秒に約 1 回処理されます。基本的な Web サイトからの同等のリクエストよりも 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

Answer 6

フィールドにアクセスする前に、現在のフォームを設定する必要があります。

「フィールドの名前を指定して、その値を指定された値に設定します。これは、現在のフォームに適用されます (「form_name()」または「form_number()」メソッドによって設定されるか、ページの最初のフォームにデフォルト設定されます)。 "

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

申し訳ありませんが、私もこのコードを試すことができません。新しい質問の質問を開いていただきありがとうございます。

Answer 7

上記のソリューションから修正されたコードを投稿する方法がわかりません。

このコードは (まだ) 正しくコンパイルされません。ただし、その方向に確実に向かうために、いくつかの重要な更新を行いました。

この更新されたコードについて助けていただければ幸いです。このサイトを実行する領主をなだめるために、このコードとこのフォローアップを投稿する方法がわかりません。

睡眠線に引っかかります。それを過ぎて進む方法についてのアドバイスは大歓迎です！

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