Зачистка нескольких элементов со страницы в аккуратный ряд

В качестве примера:

Я загружаю во вход из.txt:

Benjamin, Schuvlein, Германия,1912, М, Белый

Я делаю некоторый код, который я не буду публиковать здесь для краткости и попаду по ссылке:

https://familysearch.org/pal:/MM9.1.1/K3BN-LLJ

  1. Я хочу соскрести несколько вещей с этой страницы. В приведенном ниже коде я делаю только 1.
  2. Я также хотел бы, чтобы каждый элемент был отделен символом a в выходном файле.txt.
  3. И я хотел бы, чтобы выводу предшествовал ввод.

Я использую следующие пакеты в коде:

use strict;
use warnings;
use WWW::Mechanize::Firefox;
use Data::Dumper;
use LWP::UserAgent;
use JSON;
use CGI qw/escape/;
use HTML::DOM;

Вот соответствующий код:

my $ua = LWP::UserAgent->new;
open(my $o, '>', 'out2.txt') or die "Can't open output file: $!";
# Here is the url, although in practice, it is scraped itself using different code
my $url = 'https://familysearch.org/pal:/MM9.1.1/K3BN-LLJ'; 
print "My URL is <$url>\n";  
my $request = HTTP::Request->new(GET => $url);
  $request->push_header('Content-Type' => 'application/json');
  my $response = $ua->request($request);
 die "Error ".$response->code if !$response->is_success;
 my $dom_tree = new HTML::DOM;
 $dom_tree->write($response->content);
 $dom_tree->close;
  my $str = $dom_tree->getElementsByTagName('table')->[0]->getElementsByTagName("td")->[10]->as_text();
 print $str;
print $o $str;

Желаемый результат (по этой ссылке) выглядит примерно так:

Бенджамин, Шувляйн, Германия,1912, М, Уайт, Квинс, Нью-Йорк, Женат, Там же, Глава и т. Д.

(Какую часть этого выходного раздела можно удалить?)

Любая помощь о том, как получить ссылку в ссылке будет принята с благодарностью!

Источник

3 ответа

Это довольно просто сделать с помощью HTML::TreeBuilder::XPath чтобы получить доступ к HTML. Эта программа создает хэш данных, используя метки в качестве ключей, поэтому любую нужную информацию можно извлечь. Я заключил в кавычки любые поля, которые содержат запятые или пробелы.

Я не знаю, есть ли у вас разрешение на этот сайт для извлечения данных таким образом, но я должен обратить ваше внимание на это X-Copyright заголовок в ответах HTTP. Этот подход явно подпадает под заголовок программного доступа.

X-Copyright: ПРЕДУПРЕЖДЕНИЕ ОБ АВТОРСКИХ ПРАВАХ Данные, доступные через API FamilySearch, защищены авторским правом. Любой программный доступ, переформатирование или перенаправление этих данных без разрешения запрещены. FamilySearch считает такое несанкционированное использование нарушением своих прав на воспроизведение, создание и распространение. Свяжитесь с devnet (at) familysearch.org для получения дополнительной информации.

Должен ли я ожидать от вас письма? Я ответил на ваше первое письмо, но с тех пор не слышал.

use strict;
use warnings;

use URI;
use LWP;
use HTML::TreeBuilder::XPath;

my $url = URI->new('https://familysearch.org/pal:/MM9.1.1/K3BN-LLJ');

my $ua = LWP::UserAgent->new;
my $resp = $ua->get($url);
die $resp->status_line unless $resp->is_success;

my $tree = HTML::TreeBuilder::XPath->new_from_content($resp->decoded_content);
my @results = $tree->findnodes('//table[@class="result-data"]//tr[@class="result-item"]');
my %data;
for my $item (@results) {
  my ($key, $val) = map $_->as_trimmed_text, $item->content_list;
  $key =~ s/:$//;
  $data{$key} = $val;
}

my $record = join ',', map { local $_ = $data{$_}; /[,\s]/ ? qq<"$_"> : $_ }
  'name', 'birthplace', 'estimated birth year', 'gender', 'race (standardized)',
  'event place', 'marital status', 'residence in 1935',
  'relationship to head of household (standardized)';

print $record, "\n";

выход

"Benjamin Schuvlein",Germany,1912,Male,White,"Assembly District 2, Queens, New York City, Queens, New York, United States",Married,"Same Place",Head
Источник

Попробуй это

use LWP::Simple;
use LWP::UserAgent;
use HTML::TableExtract;

$ENV{'PERL_LWP_SSL_VERIFY_HOSTNAME'} = 0;
$ua = LWP::UserAgent->new;
$ua->agent("Mozilla/5.0 (Windows NT 5.1) AppleWebKit/537.11 (KHTML, like Gecko) Chrome/23.0.1271.91 Safari/537.11");
$req = HTTP::Request->new(GET => "https://familysearch.org/pal:/MM9.1.1/K3BN-LLJ");
$res = $ua->request($req);
$content = $res->content;
#$content = get("https://familysearch.org/pal:/MM9.1.1/K3BN-LLJ") or die "Couldn't get it! $!";
$te = HTML::TableExtract->new( attribs => { 'class' => 'result-data' } );
# $te = HTML::TableExtract->new( );
$te->parse($content);
$table = $te->first_table_found;
# print $content; exit;
# $te->tables_dump(1);
#print Dumper($te);
#print Dumper($table);
print $table->cell(4,0) . ' = ' . $table->cell(4,1), "\n"; exit;

Который распечатывает

Место проведения: = Сборочный округ 2, Квинс, Нью-Йорк, Квинс, Нью-Йорк, США

Я также заметил этот заголовок:

X-Copyright: ПРЕДУПРЕЖДЕНИЕ ОБ АВТОРСКИХ ПРАВАХ Данные, доступные через API FamilySearch, защищены авторским правом. Любой программный доступ, переформатирование или перенаправление этих данных без разрешения запрещены. FamilySearch считает такое несанкционированное использование нарушением своих прав на воспроизведение, создание и распространение. Свяжитесь с devnet (at) familysearch.org для получения дополнительной информации.

Смотрите также http://metacpan.org/pod/HTML%3A%3AElement

Источник

Я думал, что ответил на твой вопрос.

Проблема в том, что вы пытаетесь получить веб-страницу с помощью LWP. Зачем пытаться делать это, если у вас уже есть WWW::Mechanize::Firefox?

Ты пробовал это?

Он извлечет и сохранит каждую ссылку для дальнейшего анализа. Небольшое изменение, и вы "получаете" дерево DOM. Извините, у меня нет доступа к этой странице, поэтому я просто надеюсь, что это сработает.

my $i=1;
for my $link (@links) {
  print Dumper $link->url;
  print Dumper $link->text;
  my $tempfile = './$i.html';$i++;
  $mech->get( $link, ':content_file' => $tempfile, synchronize => 1 );
  my $dom_tree = $mech->document();
  my $str = $dom_tree->getElementsByTagName('table')->[0]->getElementsByTagName("td")->[9]->as_text();

 }

РЕДАКТИРОВАТЬ: Обрабатывать содержимое страницы с помощью регулярных выражений (Все: Пожалуйста, помните, всегда есть несколько способов сделать что-то с Perl!. Это работает, это легко...)

он попробовал это с этим cmd:

wget -nd ' https://familysearch.org/pal:/MM9.1.1/K3BN-LLJ' -O 1.html | cat 1.html | 1.pl

use Data::Dumper;
use strict;
use warnings;

local $/=undef;
my $html = <>;#read from file
#$html = $mech->content( format => 'html' );# read data from mech object
my $data = {};
my $current_label = "not_defined";
while ($html =~ s!(<td[^>]*>.*?</td>)!!is){ # process each TD
    my $td = $1;
    print "td: $td\n";
    my $td_val = $td;
    $td_val =~ s!<[^>]*>!!gis;
    $td_val =~ s!\s+! !gs;
    $td_val =~ s!(\A\s+|\s+\z)!!gs;
    if      ($td =~ m!result-label!){ #primitive state machine, store the current label
        print "current_label: $current_label\n";
        $current_label = $td_val;
    } elsif ($td =~ m!result-value!){ #add each data to current label
        push(@{$data->{$current_label}},$td_val);

    } else {
        warn "found something else: $td\n";
    }
}
#process it using a white lists of known entries (son,race, etc).Delete from the result if you find it on white list, die if you find something new.
#multi type
foreach my $type (qw(son wife daughter head)){
    process_multi($type,$data->{$type});
    delete($data->{$type});
}
#simple type
foreach my $type (qw(birthplace age)){
    process_simple($type,$data->{$type});
    delete($data->{$type});
}

die "Unknown label!".Dumper($data) if scalar(keys %{$data})>0;

Выход:

      'line number:' => [
                          '28'
                        ],
      'estimated birth year:' => [
                                   '1912'
                                 ],
      'head' => [
                  'Benjamin Schuvlein',
                  'M',
                  '28',
                  'Germany'
                ],
Источник
Другие вопросы по тегам