Question

我对perl非常陌生，这是我第一次使用任何perl脚本。我有一个脚本来解析pubmed

中的emailID

#!/usr/bin/perl -w
# A perlscript written by Joseph Hughes, University of Glasgow
# use this perl script to parse the email addressed from the affiliations in PubMed

use strict;
#use LWP::Simple;
use LWP::Protocol::https;
use LWP::UserAgent;


my ($query,@queries);
#Query the Journal of Virology from 2014 until the present (use 3000)
$query = 'journal+of+virology[journal]+AND+2014[Date+-+Publication]:3000[Date+-+Publication]';
push(@queries,$query);
#Journal of General Virology
$query = 'journal+of+general+virology[journal]+AND+2014[Date+-+Publication]:3000[Date+-+Publication]';
push(@queries,$query);
#Virology
$query = 'virology[journal]+AND+2014[Date+-+Publication]:3000[Date+-+Publication]';
push(@queries,$query);
#Archives of Virology
$query = 'archives+of+virology[journal]+AND+2014[Date+-+Publication]:3000[Date+-+Publication]';
push(@queries,$query);
#Virus Research
$query = 'virus+research[journal]+AND+2014[Date+-+Publication]:3000[Date+-+Publication]';
push(@queries,$query);
#Antiviral Research
$query = 'antiviral+research[journal]+AND+2014[Date+-+Publication]:3000[Date+-+Publication]';
push(@queries,$query);
#Viruses
$query = 'viruses[journal]+AND+2014[Date+-+Publication]:3000[Date+-+Publication]';
push(@queries,$query);
#Journal of Medical Virology
$query = 'journal+of+medical+virology[journal]+AND+2014[Date+-+Publication]:3000[Date+-+Publication]';

# global variables
push(@queries,$query);
my %emails;
my $emailcnt=0;
my $count=1;
#assemble the esearch URL
foreach my $query (@queries){
  my $base = 'http://eutils.ncbi.nlm.nih.gov/entrez/eutils/';
  my $url = $base . "esearch.fcgi?db=pubmed&term=$query&usehistory=y";
  #my $url = "http://eutils.ncbi.nlm.nih.gov/entrez/eutils/esearch.fcgi?db=pubmed&term=journal+of+medical+virology[journal]+AND+2014[Date+-+Publication]:3000[Date+-+Publication]&usehistory=y";
  print "\n before url \n";
  print $url;
  #post the esearch URL
  #my $output = get($url);
  my $ua = LWP::UserAgent->new(timeout => 30);
  $ua->ssl_opts( verify_hostname => 0 );
  my $response = $ua->get($url);
  print "before response";
  print $response;
  unless ($response->is_success) {
  # the Client-Warning, Client-Aborted, and X-Died headers each may be set on client/transport errors
  die $response->status_line;
  }
my $output = $response->decoded_content;
  print "\n before output \n";
  print $output;
  #parse WebEnv, QueryKey and Count (# records retrieved)
  my $web = $1 if ($output =~ /<WebEnv>(\S+)<\/WebEnv>/);
  my $key = $1 if ($output =~ /<QueryKey>(\d+)<\/QueryKey>/);
  my $count = $1 if ($output =~ /<Count>(\d+)<\/Count>/);

  #retrieve data in batches of 500
  my $retmax = 500;
  for (my $retstart = 0; $retstart < $count; $retstart += $retmax) {
    my $efetch_url = $base ."efetch.fcgi?db=pubmed&WebEnv=$web";
    $efetch_url .= "&query_key=$key&retmode=xml";
    my $efetch_out = LWP::UserAgent->new(timeout => 30)->get($efetch_url);
    my @matches = $efetch_out =~ m(<Affiliation>(.*)</Affiliation>)g;
    #print "$_\n" for @matches;
    for my $match (@matches){
      if ($match=~/\s([a-zA-Z0-9\.\_\-]+\@[a-zA-Z0-9\.\_\-]+)$/){
        my $email=$1;
        $email=~s/\.$//;
        $emails{$email}++;
      }     
    }
  }
  my $cnt= keys %emails;
  print "$query\n$cnt\n";
}

print "Total number of emails: ";
my $cnt= keys %emails;
print "$cnt\n";
my @email = keys %emails;
my @VAR;
push @VAR, [ splice @email, 0, 100 ] while @email;

my $batch=100;
foreach my $VAR (@VAR){
    open(OUT, ">Set_$batch\.txt") || die "Can't open file!\n";
    print OUT join(",",@$VAR);
    close OUT;
    $batch=$batch+100;
}

运行正常，但是运行后，我得到Total number of emails: 0，我敢肯定实际上不是这种情况。

我们知道这里发生了什么吗？我可以看到这样的结果

<?xml version="1.0" encoding="UTF-8" ?>
<!DOCTYPE eSearchResult PUBLIC "-//NLM//DTD esearch 20060628//EN" "https://eutils.ncbi.nlm.nih.gov/eutils/dtd/20060628/esearch.dtd">
<eSearchResult><Count>1552</Count><RetMax>20</RetMax><RetStart>0</RetStart><QueryKey>1</QueryKey><WebEnv>NCID_1_108762718_130.14.18.34_9001_1545718459_2017377343_0MetA0_S_MegaStore</WebEnv><IdList>
<Id>30578684</Id>
<Id>30578670</Id>
<Id>30575982</Id>
<Id>30570784</Id>
<Id>30570771</Id>
<Id>30570770</Id>
<Id>30570759</Id>
<Id>30570750</Id>
<Id>30560545</Id>
<Id>30552705</Id>
<Id>30549048</Id>
<Id>30548936</Id>
<Id>30548642</Id>
<Id>30537228</Id>
<Id>30537157</Id>
<Id>30516836</Id>
<Id>30515847</Id>
<Id>30512182</Id>
<Id>30512180</Id>
<Id>30489644</Id>

获取请求运行后

脚本来源：Script link on github

Answer 1

此脚本可以进行一些重构，因此实际上可以调试和维护它。

可能使用面向对象的方法会很有帮助，对我来说，将@queries声明重新表达为适当的列表声明，并清除一些残骸，将变量重命名为它们实际执行的操作而不是注释（retmax-> batch_size？）似乎很容易完成。

处理错误将排在我的清单上（如果没有找到查询参数，会发生什么？尽管计数为0 /没有找到，脚本仍会继续，这种行为在调试时会造成混淆）

我还没有为您完成此操作，也不确定是否可以使用电子邮件的网络抓取工具，但是除此之外：

如果将注释为#print "$_\n" for @matches;的行更改为print "no emails found for query '$query'\n" unless @matches;，您将清楚地看到脚本为什么不执行所需的操作。

Answer 2

如果不自己运行代码，我会推测代码中的@matches数组为空。尝试取消注释print语句，以验证@match是否已按预期分配，然后从那里向前或向后工作以缩小哪些语句没有达到预期的效果。

my @matches = $efetch_out =~ m(<Affiliation>(.*)</Affiliation>)g;
#print "$_\n" for @matches;

话虽如此，理想情况下，出于可维护性考虑，应完全以较少的过程样式完全重写此代码。

perl脚本来解析pubmed中的数据而不返回数据

2 个答案: