/usr/share/perl5/GO/Parsers/locuslink_parser.pm is in libgo-perl 0.15-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 | # $Id: locuslink_parser.pm,v 1.1 2004/01/27 23:52:24 cmungall Exp $
#
# Adapterd from BioPerl module for Bio::SeqIO::locuslink
#
# POD documentation - main docs before the code
=head1 NAME
GO::Parsers::locuslink_parser - Parser for LocusLink
=head1 SYNOPSIS
=head1 DESCRIPTION
=cut
package GO::Parsers::locuslink_parser;
use strict;
use vars qw(@ISA);
use base qw(GO::Parsers::base_parser);
sub _initialize {
my($self,@args) = @_;
$self->SUPER::_initialize(@args);
}
sub transitions {
return
qw(
NM transcript
NG 0
CONTIG 0
EVID evidence
ACCNUM accession
OFFICIAL_SYMBOL 0
BUTTON url
DB_DESCR dbxref
/DB_LINK dbxref
);
}
sub compounds {
return
(
STS => [qw(sts_acc chr_num unk symbol type src)],
GO => [qw(aspect term evcode go_acc src unk)],
EXTANNOT => [qw(aspect term evcode src unk)],
CDD => [qw(domain domain_acc num unk score)],
NG => [qw(acc u1 u2 u3 u4)],
CONTIG => [qw(contig_acc u1 u2 u3 u4 strand chr_num src)],
XM => [qw(acc gi)],
XP => [qw(acc gi)],
XG => [qw(acc gi)],
ACCNUM => [qw(acc gi)],
PROT => [qw(acc gi)],
MAP => [qw(map_loc link code)],
SUMFUNC => [qw(descr src)],
GRIF => [qw(grif_pmid descr)],
COMP => [qw(comp_acc symbol2 chr_num2 map_pos2 locusacc2 chr_num1 symbol1 src)],
);
}
sub record_tag {'locusset'}
sub parse_fh {
my $self = shift;
my $fh = shift;
$self->start_event('locusset');
my (%record,@results,$search,$ref,$cddref);
my ($PRESENT,@keep);
# LOCUSLINK entries begin w/ >>
local $/=">>";
# slurp in a whole entry and return if no more entries
return unless my $entry = <$fh>;
# if its the first entry you have to slurp it in again
if ($entry eq '>>'){ #first entry
return unless $entry = <$fh>;
}
if (!($entry=~/LOCUSID/)){
$self->throw("No LOCUSID in first line of record. ".
"Not LocusLink in my book.");
}
my %transitions = $self->transitions;
my %compounds = $self->compounds;
# my %grouped = ();
# foreach (keys %transitions) {
# if (/\;/) {
# my $t = $transitions{$_};
# my (@keylist) = split(/\;/, $_);
# foreach (@keylist) {
# $transitions{$_} = $t;
# $grouped{$_} = $t;
# }
# }
# }
$self->start_event('locus');
my $level = 0;
my @lines = split(/\n/, $entry);
foreach (@lines) {
if (/(\w+):\s*(.*)/) {
my ($k, $v) = (uc($1), $2);
my $transition = $transitions{$k};
if (defined $transition) {
if (!$transition) {
if ($level) {
#$self->throw("uh oh $_") unless $level;
$self->end_event($level);
}
$level = 0;
}
elsif ($transition eq $level) {
$self->end_event($level);
$self->start_event($level);
}
else {
if ($level) {
$self->end_event($level);
$level = 0;
}
$self->start_event($transition);
$level = $transition;
}
}
# for grouped keys, every key must be part of
# group to remain part of the same super-element
# if ($level &&
# $grouped{$level}) {
# if (!$grouped{$k} ||
# $grouped{$k} ne $grouped{$level}) {
# $self->end_event($level);
# $level = 0;
# }
# }
if ($compounds{$k}) {
my (@vals) = split(/\|/, $v);
my @pairs = ([defline=>$v]);
foreach (@{$compounds{$k}}) {
my $v = shift @vals;
push(@pairs, [$_ => $v]) unless $v eq 'na';
}
$self->event(lc($k) => [@pairs]);
}
else {
$self->event(lc($k), $v);
}
my $end = $transitions{'/'.$k};
if ($end) {
$self->end_event($end);
$level = 0;
}
}
}
if ($level) {
$self->end_event($level);
}
$self->end_event('locus');
$self->end_event('locusset');
return;
}
1;
|