Ваш код довольно длинный, поэтому мой ответ представит суть идеи только с несколькими примерами обработанных элементов.Но это должно дать вам отправную точку, как обрабатывать другие элементы в ваших XML-данных.
#!/usr/bin/perl
use strict;
use warnings;
use XML::LibXML;
# XML namespace
use constant DEFAULT_XMLNS => 'http://www.ebi.ac.uk/interpro/resources/schemas/interproscan5';
my $doc;
eval {
$doc = XML::LibXML->load_xml(IO => \*STDIN);
};
die "XML parser error: $@\n"
if $@;
# initialize XPath context
# NOTE: all nodes without NS must use default: prefix!
my $xpc = XML::LibXML::XPathContext->new();
$xpc->registerNs('default', DEFAULT_XMLNS);
# Signature processors - code
sub processor_just_primary {
my($protein, $key, $primary) = @_;
push(@{ $protein->{$key} }, $primary);
}
sub processor_primary_and_first_attr {
my($protein, $key, $primary, $attrs) = @_;
push(@{ $protein->{$key} }, "${primary}: " . $attrs->[0]);
}
# Signature processors - map key, "ac" identifier, attributes, code
my %signature_processors = (
Gene3D => {
id => qr/^G3DSA:(.+)/,
attr => [],
code => \&processor_just_primary,
},
Hamap => {
id => qr/^(MF.+)/,
attr => [ qw{desc name} ],
code => \&processor_primary_and_first_attr,
},
PANTHER => {
id => qr/^(PTHR.+)/,
attr => [ qw{name} ],
code => \&processor_primary_and_first_attr,
},
TIGRFAM => {
id => qr/^(TIGR.+)/,
attr => [ qw{desc name} ],
code => \&processor_primary_and_first_attr,
},
);
my @proteins;
foreach my $protein_node ($xpc->findnodes('//default:protein', $doc)) {
# search <xref> node downwards from <protein> node
my @xrefs = $xpc->findnodes('./default:xref', $protein_node)
or die "Can't find xref node for protein " . $protein_node->toString() . "\n";
my $id = $xrefs[0]->getAttribute('id')
or die "Can't get attribute 'id' for protein " . $xrefs[0]->toString() . "\n";
# initialize new protein
# NOTE: a key with an undefined value means "not found" -> empty column
my %protein = map { ($_ => undef) } keys %signature_processors;
$protein{ID} = $id;
push(@proteins, \%protein);
# fill protein with signature matches - searching nodes downwards from <protein/matches> node
foreach my $signature ($xpc->findnodes('./default:matches//default:signature', $protein_node)) {
my($attr_ac) = $signature->getAttribute('ac')
or die "Can't get attribute 'ac' for XML node " . $signature->toString() . "\n";
while (my($key, $processor) = each %signature_processors) {
my($primary) = ($attr_ac =~ $processor->{id})
or next;
# additional attributes
my @attrs;
foreach my $attr (@{ $processor->{attr} }) {
my($value) = $signature->getAttribute($attr)
or die "Can't get attribute '${attr}' for XML node " . $signature->toString() . "\n";
push(@attrs, $value);
}
# call processor
$processor->{code}->(\%protein, $key, $primary, \@attrs);
}
}
}
my @key_order = qw(
TIGRFAM
Hamap
PANTHER
Gene3D
);
sub dump_row(@) {
print join("\t", @_), "\n";
}
dump_row('ID', @key_order);
foreach my $protein (@proteins) {
my @columns =
map { $_ ? join('; ', @{ $_ }) : '-' } # handle empty columns
@{ $protein }{@key_order};
dump_row($protein->{ID}, @columns);
}
exit 0;
Тестовый вывод для примера 1:
$ perl dummy.pl <Downloads/c73whyqk.txt
ID TIGRFAM Hamap PANTHER Gene3D
id_10002 - - - -
id_10001 TIGR00621: ssb: single-stranded DNA-binding protein MF_00984: Single-stranded DNA-binding protein. PTHR10302:SF0: SINGLE-STRANDED DNA-BINDING PROTEIN, MITOCHONDRIAL; PTHR10302: SINGLE-STRANDED DNA-BINDING PROTEIN 2.40.50.140
id_10003 - - PTHR34107: FAMILY NOT NAMED 3.90.1570.10
Тестовый вывод для примера 2:
$ perl dummy.pl <dummy.xml
ID TIGRFAM Hamap PANTHER Gene3D
id_10005 - - PTHR13696:SF85: SUBFAMILY NOT NAMED; PTHR13696: FAMILY NOT NAMED 3.40.50.300
id_10004 - - PTHR13696:SF86: SUBFAMILY NOT NAMED; PTHR13696: FAMILY NOT NAMED 3.40.50.300
КОД БОНУСА: , так как вопрос также помечен csv Я добавлю изменения, необходимые для генерации вывода CSV:
#!/usr/bin/perl
use strict;
use warnings;
use Text::CSV;
use XML::LibXML;
# ... the main code is left unchanged ...
my $csv = Text::CSV->new()
or die "Cannot use CSV: " . Text::CSV->error_diag() . "\n";
$csv->eol("\n");
sub dump_row(@) {
$csv->print(\*STDOUT, \@_);
}
dump_row('ID', @key_order);
foreach my $protein (@proteins) {
my @columns =
map { $_ ? join('; ', @{ $_ }) : '' } # handle empty columns
@{ $protein }{@key_order};
dump_row($protein->{ID}, @columns);
}
exit 0;
ОБНОВЛЕНИЕ 2: оказывается, что загрузка версии TSV исходного кода может привести к проблеме, когда ваш импортер CSV не имеет возможности отключить , (запятая) и ; (точка с запятой) в качестве разделителей.Исходный код должен быть переписан таким образом, чтобы вместо него использовалось Text :: CSV , что приводит к правильному цитированию и, следовательно, позволяет избежать подобных проблем.
Я также добавил некоторый проверочный код для @key_orderпротив %signature_processors.
# sanity checks
die "\@keyorder has keys not in \%signature_processors!\n"
if grep { not exists $signature_processors{$_} } @key_order;
{
my %keys = map { ($_ => 1) } @key_order;
die "\%signature_processors has keys not in \@keyorder!\n"
if grep { not exists $keys{$_} } keys %signature_processors;
}
my $csv = Text::CSV->new({
binary => 1,
eol => "\n",
# Select the output format by uncommenting *one* of the following
#sep_char => ',', # CSV - comma separated values
sep_char => "\t", # TSV - TAB separated values
})
or die "Cannot use CSV: " . Text::CSV->error_diag() . "\n";
sub dump_row(@) {
$csv->print(\*STDOUT, \@_);
}