1
1
package Bio::DB::GFF::Adaptor::memory;
5
Bio::DB::GFF::Adaptor::dbi::mysql -- Database adaptor for a specific mysql schema
10
my $db = Bio::DB::GFF->new(-adaptor=> 'memory',
11
-gff => 'my_features.gff',
15
See L<Bio::DB::GFF> for other methods.
19
This adaptor implements an in-memory version of Bio::DB::GFF. It can be used to
20
store and retrieve SHORT GFF files. It inherits from Bio::DB::GFF.
24
Use Bio::DB::GFF-E<gt>new() to construct new instances of this class.
25
Three named arguments are recommended:
29
-adaptor Set to "memory" to create an instance of this class.
30
-gff Read the indicated file or directory of .gff file.
31
-fasta Read the indicated file or directory of fasta files.
32
-dir Indicates a directory containing .gff and .fa files
34
If you use the -dsn option and the indicated directory is writable by
35
the current process, then this library will create a FASTA file index
36
that greatly diminishes the memory usage of this module.
40
See L<Bio::DB::GFF> for inherited methods.
48
L<Bio::DB::GFF>, L<bioperl>
52
Shuly Avraham E<lt>avraham@cshl.orgE<gt>.
54
Copyright (c) 2002 Cold Spring Harbor Laboratory.
56
This library is free software; you can redistribute it and/or modify
57
it under the same terms as Perl itself.
62
# $Id: memory.pm,v 1.21 2003/12/17 18:25:42 scain Exp $
63
# AUTHOR: Shulamit Avraham
64
# This module needs to be cleaned up and documented
66
# Bio::DB::GFF::Adaptor::memory -- in-memory db adaptor
67
# implements the low level handling of data which stored in memory.
68
# This adaptor implements a specific in memory schema that is compatible with Bio::DB::GFF.
69
# Inherits from Bio::DB::GFF.
72
#use lib './blib/lib';
73
#use lib '/u/swiss/shuly/bioperl-live';
74
# use lib '/a/swiss/export/home/shuly/bioperl-live';
5
76
use Bio::DB::GFF::Util::Rearrange; # for rearrange()
6
use vars qw($VERSION @ISA);
77
use Bio::DB::GFF::Adaptor::memory_iterator;
78
use File::Basename 'dirname';
8
82
use constant MAX_SEGMENT => 100_000_000; # the largest a segment can get
10
84
@ISA = qw(Bio::DB::GFF);
14
87
my $class = shift ;
15
my ($file) = rearrange([
88
my ($file,$fasta,$dbdir,$preferred_groups) = rearrange([
91
[qw(DSN DB DIR DIRECTORY)],
20
96
my $self = bless{ data => [] },$class;
21
$self->load($file) if $file;
97
$self->preferred_groups($preferred_groups) if defined $preferred_groups;
100
$self->load_gff($file) if $file;
101
$self->load_or_store_fasta($fasta) if $fasta;
105
sub load_or_store_fasta {
108
if ((-f $fasta && -w dirname($fasta))
110
(-d $fasta && -w $fasta)) {
111
require Bio::DB::Fasta;
112
my $dna_db = eval {Bio::DB::Fasta->new($fasta)}
113
or warn "No sequence available. Use -gff instead of -dir if you wish to load features without sequence.\n";
114
$dna_db && $self->dna_db($dna_db);
116
$self->load_fasta($fasta);
122
my $d = $self->{dna_db};
123
$self->{dna_db} = shift if @_;
25
127
sub insert_sequence {
27
129
my($id,$offset,$seq) = @_;
28
130
$self->{dna}{$id} .= $seq;
133
# low-level fetch of a DNA substring given its
134
# name, class and the desired range.
33
137
my ($id,$start,$stop,$class) = @_;
138
if (my $dna_db = $self->dna_db) {
139
return $dna_db->seq($id,$start=>$stop);
142
return $self->{dna}{$id} if !defined $start || !defined $stop;
143
$start = 1 if !defined $start;
35
146
if ($start > $stop) {
159
# this method loads the feature as a hash into memory -
160
# keeps an array of features-hashes as an in-memory db
48
161
sub load_gff_line {
50
163
my $feature_hash = shift;
51
$feature_hash->{strand} = '+' if $feature_hash->{strand} eq '.';
52
$feature_hash->{phase} = '+' if $feature_hash->{phase} eq '.';
164
$feature_hash->{strand} = '' if $feature_hash->{strand} && $feature_hash->{strand} eq '.';
165
$feature_hash->{phase} = '' if $feature_hash->{phase} && $feature_hash->{phase} eq '.';
53
166
push @{$self->{data}},$feature_hash;
169
# given sequence name, return (reference,start,stop,strand)
56
170
sub get_abscoords {
58
172
my ($name,$class,$refseq) = @_;
176
if ($name =~ /[*?]/) { # uh oh regexp time
177
$name =~ quotemeta($name);
178
$name =~ s/\\\*/.*/g;
179
$name =~ s/\\\?/.?/g;
61
183
# Find all features that have the requested name and class.
62
#for my $type (@$typelist) {
63
# my ($method,$source) = @$type;
64
# if defined $method && length $method {
65
# next unless $feature_method ;
68
184
# Sort them by reference point.
69
185
for my $feature (@{$self->{data}}) {
70
next unless $feature->{gname} eq $name;
71
next unless $feature->{gclass} eq $class;
187
my $no_match_class_name;
188
my $empty_class_name;
189
if (defined $feature->{gname} and defined $feature->{gclass}){
190
my $matches = $feature->{gclass} eq $class
191
&& ($regexp ? $feature->{gname} =~ /$name/i : $feature->{gname} eq $name);
192
$no_match_class_name = !$matches; # to accomodate Shuly's interesting logic
196
$empty_class_name = 1;
199
if ($no_match_class_name || $empty_class_name){
201
my $feature_attributes = $feature->{attributes};
202
my $attributes = {Alias => $name};
203
if (!_matching_attributes($feature_attributes,$attributes)){
72
207
push @{$refs{$feature->{ref}}},$feature;
75
210
# find out how many reference points we recovered
213
$self->error("$name not found in database");
215
} elsif (keys %refs > 1) {
216
$self->error("$name has more than one reference sequence in database");
220
# compute min and max
221
my ($ref) = keys %refs;
222
my @found = @{$refs{$ref}};
223
my ($strand,$start,$stop);
76
225
my @found_segments;
77
226
foreach my $ref (keys %refs) {
78
227
next if defined($refseq) and $ref ne $refseq;
80
229
my ($strand,$start,$stop);
81
230
foreach (@found) {
82
231
$strand ||= $_->{strand};
83
$strand = '+' if $strand eq '.';
232
$strand = '+' if $strand && $strand eq '.';
84
233
$start = $_->{start} if !defined($start) || $start > $_->{start};
85
234
$stop = $_->{stop} if !defined($stop) || $stop < $_->{stop};
87
236
push @found_segments,[$ref,$class,$start,$stop,$strand];
89
239
return \@found_segments;
95
# my ($search,$options,$callback) = @_;
99
# for my $feature (@{$self->{data}}) {
100
# my $feature_start = $feature->{start};
101
# my $feature_stop = $feature->{stop};
102
# my $feature_ref = $feature->{ref};
103
# next unless $feature_ref eq $search->{refseq};
105
# my $rangetype = $search->{rangetype};
106
# if ($rangetype eq 'overlap') {
107
# next unless $feature_stop >= $search->{start} && $feature_start <= $search->{stop};
108
# } elsif ($rangetype eq 'contains') {
109
# next unless $feature_start >= $search->{start} && $feature_stop <= $search->{stop};
110
# } elsif ($rangetype eq 'contained_in') {
111
# next unless $feature_start <= $search->{start} && $feature_stop >= $search->{stop};
113
# next unless $feature_start == $search->{start} && $feature_stop == $search->{stop};
116
# my $feature_source = $feature->{source};
117
# my $feature_method = $feature->{method};
119
# foreach (@{$search->{types}}) {
120
# my ($search_method,$search_source) = @$_;
121
# next if $search_method ne $feature_method;
122
# next if defined($search_source) && $search_source ne $feature_source;
125
# if we get here, then we have a feature that meets the criteria.
126
# If we were asked to sort by group, then we just push onto an array
127
# of found features and continue. Otherwise we call the callback
129
# if ($options->{sort_by_group}) {
130
# push @found_features,$feature;
133
# $callback->($feature_ref,
139
# $feature->{strand},
141
# $feature->{gclass},
143
# $feature->{tstart},
149
# for my $feature (sort
150
# {"$a->{gclass}:$a->{gname}" cmp "$b->{gclass}:$b->{gname}"
151
# } @found_features) { # only true if the sort by group option was specified
153
# @{$feature}{qw(ref start stop source method score strand phase gclass gname tstart tstop)}
244
my ($search_string,$limit) = @_;
246
my @words = map {quotemeta($_)} $search_string =~ /(\w+)/g;
248
for my $feature (@{$self->{data}}) {
249
next unless defined $feature->{gclass} && defined $feature->{gname}; # ignore NULL objects
250
next unless $feature->{attributes};
251
my @attributes = @{$feature->{attributes}};
252
my @values = map {$_->[1]} @attributes;
253
my $value = "@values";
257
my @hits = $value =~ /($w)/g;
258
$note ||= $value if @hits;
261
next unless $matches;
263
my $relevance = 10 * $matches;
264
my $featname = Bio::DB::GFF::Featname->new($feature->{gclass}=>$feature->{gname});
265
push @results,[$featname,$note,$relevance];
266
last if @results >= $limit;
271
sub _delete_features {
273
my @feature_ids = sort {$b<=>$a} @_;
275
foreach (@feature_ids) {
276
next unless $_ >= 0 && $_ < @{$self->{data}};
277
$removed += defined splice(@{$self->{data}},$_,1);
284
my $delete_spec = shift;
285
my $ranges = $delete_spec->{segments} || [];
286
my $types = $delete_spec->{types} || [];
287
my $force = $delete_spec->{force};
288
my $range_type = $delete_spec->{range_type};
292
my @args = @$types ? (-type=>$types) : ();
293
push @args,(-range_type => $range_type);
294
my %ids_to_remove = map {$_->id => 1} map {$_->features(@args)} @$ranges;
295
$deleted = $self->delete_features(keys %ids_to_remove);
297
my %ids_to_remove = map {$_->id => 1} $self->features(-type=>$types);
298
$deleted = $self->delete_features(keys %ids_to_remove);
300
$self->throw("This operation would delete all feature data and -force not specified")
302
$deleted = @{$self->{data}};
303
@{$self->{data}} = ();
310
# Some GFF version 2 files use the groups column to store a series of
311
# attribute/value pairs. In this interpretation of GFF, the first such
312
# pair is treated as the primary group for the feature; subsequent pairs
313
# are treated as attributes. Two attributes have special meaning:
314
# "Note" is for backward compatibility and is used for unstructured text
315
# remarks. "Alias" is considered as a synonym for the feature name.
316
# If no name is provided, then attributes() returns a flattened hash, of
317
# attribute=>value pairs.
321
my ($feature_id,$tag) = @_;
324
my $feature = ${$self->{data}}[$feature_id];
326
for my $attr (@{$feature->{attributes}}) {
327
my ($attr_name,$attr_value) = @$attr ;
328
if (defined($tag) && $attr_name eq $tag){push @result,$attr_value;}
329
elsif (!defined($tag)) {push @result,($attr_name,$attr_value);}
335
#sub get_feature_by_attribute{
336
sub _feature_by_attribute{
338
my ($attributes,$callback) = @_;
339
$callback || $self->throw('must provide a callback argument');
342
my $feature_group_id = undef;
344
for my $feature (@{$self->{data}}) {
347
for my $attr (@{$feature->{attributes}}) {
348
my ($attr_name,$attr_value) = @$attr ;
349
#there could be more than one set of attributes......
350
foreach (keys %$attributes) {
351
if ($_ eq $attr_name && $attributes->{$_} eq $attr_value){
352
$callback->($feature->{ref},
376
# This is the low-level method that is called to retrieve GFF lines from
377
# the database. It is responsible for retrieving features that satisfy
378
# range and feature type criteria, and passing the GFF fields to a
379
# callback subroutine.
159
381
sub get_features{
160
382
my $self = shift;
161
my ($rangetype,$refseq,$class,$start,$stop,$types,$sparse,$callback,$order_by_group) = @_;
165
for my $feature (@{$self->{data}}) {
166
my $feature_start = $feature->{start};
167
my $feature_stop = $feature->{stop};
168
my $feature_ref = $feature->{ref};
169
next unless $feature_ref eq $refseq;
172
if (defined $start or defined $stop) {
173
$start = 0 unless defined($start);
174
$stop = MAX_SEGMENT unless defined($stop);
176
if ($rangetype eq 'overlaps') {
177
next unless $feature_stop >= $start && $feature_start <= $stop;
178
} elsif ($rangetype eq 'contains') {
179
next unless $feature_start >= $start && $feature_stop <= $stop;
180
} elsif ($rangetype eq 'contained_in') {
181
next unless $feature_start <= $start && $feature_stop >= $stop;
183
next unless $feature_start == $start && $feature_stop == $stop;
188
my $feature_source = $feature->{source};
189
my $feature_method = $feature->{method};
191
if (defined $types && @$types){
192
next unless _matching_typelist($feature_method,$feature_source,$types);
195
# if we get here, then we have a feature that meets the criteria.
196
# If we were asked to sort by group, then we just push onto an array
197
# of found features and continue. Otherwise we call the callback
199
if ($order_by_group) {
200
push @found_features,$feature;
203
$callback->($feature_ref,
219
for my $feature (sort
220
{"$a->{gclass}:$a->{gname}" cmp "$b->{gclass}:$b->{gname}"
221
} @found_features) { # only true if the sort by group option was specified
384
my ($search,$options,$callback) = @_;
385
my $data = \@{$self->{data}};
389
$found_features = _get_features_by_search_options($data,$search,$options);
391
# only true if the sort by group option was specified
392
@{$found_features} = sort {"$a->{gclass}:$a->{gname}" cmp "$b->{gclass}:$b->{gname}"}
393
@{$found_features} if $options->{sort_by_group} ;
395
for my $feature (@{$found_features}) { # only true if the sort by group option was specified
223
@{$feature}{qw(ref start stop source method score strand phase gclass gname tstart tstop)}
398
@{$feature}{qw(ref start stop source method score strand phase gclass gname tstart tstop feature_id feature_group_id)}
406
# Low level implementation of fetching a named feature.
407
# GFF annotations are named using the group class and name fields.
408
# May return zero, one, or several Bio::DB::GFF::Feature objects.
410
=head2 _feature_by_name
412
Title : _feature_by_name
413
Usage : $db->get_features_by_name($name,$class,$callback)
414
Function: get a list of features by name and class
415
Returns : count of number of features retrieved
416
Args : name of feature, class of feature, and a callback
419
This method is used internally. The callback arguments are those used
424
sub _feature_by_name {
426
my ($class,$name,$location,$callback) = @_;
427
$callback || $self->throw('must provide a callback argument');
432
if ($name =~ /[*?]/) { # uh oh regexp time
433
$name = quotemeta($name);
434
$name =~ s/\\\*/.*/g;
435
$name =~ s/\\\?/.?/g;
440
for my $feature (@{$self->{data}}) {
442
next unless ($regexp && $feature->{gname} =~ /$name/i) || $feature->{gname} eq $name;
443
next unless $feature->{gclass} eq $class;
445
next if $location->[0] ne $feature->{ref};
446
next if $location->[1] && $location->[1] > $feature->{stop};
447
next if $location->[2] && $location->[2] < $feature->{start};
450
$callback->(@{$feature}{qw(
469
# Low level implementation of fetching a feature by it's id.
470
# The id of the feature as implemented in the in-memory db, is the location of the
471
# feature in the features hash array.
474
my ($ids,$type,$callback) = @_;
475
$callback || $self->throw('must provide a callback argument');
477
my $feature_group_id = undef;
480
if ($type eq 'feature'){
481
for my $feature_id (@$ids){
482
my $feature = ${$self->{data}}[$feature_id];
484
$callback->($feature->{ref},
505
# This method is similar to get_features(), except that it returns an
506
# iterator across the query.
507
# See Bio::DB::GFF::Adaptor::memory_iterator.
509
sub get_features_iterator {
511
my ($search,$options,$callback) = @_;
512
$callback || $self->throw('must provide a callback argument');
514
my $data = \@{$self->{data}};
515
my $results = _get_features_by_search_options($data,$search,$options);
516
my $results_array = _convert_feature_hash_to_array($results);
518
return Bio::DB::GFF::Adaptor::memory_iterator->new($results_array,$callback);
524
# This method is responsible for fetching the list of feature type names.
525
# The query may be limited to a particular range, in
526
# which case the range is indicated by a landmark sequence name and
527
# class and its subrange, if any. These arguments may be undef if it is
528
# desired to retrieve all feature types.
530
# If the count flag is false, the method returns a simple list of
531
# Bio::DB::GFF::Typename objects. If $count is true, the method returns
532
# a list of $name=>$count pairs, where $count indicates the number of
533
# times this feature occurs in the range.
230
536
my $self = shift;
271
sub _matching_typelist{
580
# Internal method that performs a search on the features array,
581
# sequentialy retrieves the features, and performs a check on each feature
582
# according to the search options.
583
sub _get_features_by_search_options{
585
my ($data,$search,$options) = @_;
586
my ($rangetype,$refseq,$class,$start,$stop,$types,$sparse,$order_by_group,$attributes) =
587
(@{$search}{qw(rangetype refseq refclass start stop types)},
588
@{$options}{qw(sparse sort_by_group ATTRIBUTES)}) ;
592
my $feature_id = -1 ;
593
my $feature_group_id = undef;
595
for my $feature (@{$data}) {
599
my $feature_start = $feature->{start};
600
my $feature_stop = $feature->{stop};
601
my $feature_ref = $feature->{ref};
603
if (defined $refseq){
604
next unless $feature_ref eq $refseq;
607
if (defined $start or defined $stop) {
608
$start = 0 unless defined($start);
609
$stop = MAX_SEGMENT unless defined($stop);
611
if ($rangetype eq 'overlaps') {
612
next unless $feature_stop >= $start && $feature_start <= $stop;
613
} elsif ($rangetype eq 'contains') {
614
next unless $feature_start >= $start && $feature_stop <= $stop;
615
} elsif ($rangetype eq 'contained_in') {
616
next unless $feature_start <= $start && $feature_stop >= $stop;
618
next unless $feature_start == $start && $feature_stop == $stop;
623
my $feature_source = $feature->{source};
624
my $feature_method = $feature->{method};
626
if (defined $types && @$types){
627
next unless _matching_typelist($feature_method,$feature_source,$types);
630
my $feature_attributes = $feature->{attributes};
631
if (defined $attributes){
632
next unless _matching_attributes($feature_attributes,$attributes);
635
# if we get here, then we have a feature that meets the criteria.
636
# Then we just push onto an array
637
# of found features and continue.
639
my $found_feature = $feature ;
640
$found_feature->{feature_id} = $feature_id;
641
$found_feature->{group_id} = $feature_group_id;
642
push @found_features,$found_feature;
646
return \@found_features;
653
# this subroutine is needed for convertion of the feature from hash to array in order to
654
# pass it to the callback subroutine
655
sub _convert_feature_hash_to_array{
656
my @features_hash_array = @_;
658
use constant FREF => 0;
659
use constant FSTART => 1;
660
use constant FSTOP => 2;
661
use constant FSOURCE => 3;
662
use constant FMETHOD => 4;
663
use constant FSCORE => 5;
664
use constant FSTRAND => 6;
665
use constant FPHASE => 7;
666
use constant GCLASS => 8;
667
use constant GNAME => 9;
668
use constant TSTART => 10;
669
use constant TSTOP => 11;
670
use constant FID => 12;
671
use constant GID => 13;
673
my @features_array_array;
674
my $feature_count = 0;
676
for my $feature_hash (@{$features_hash_array[0]}){
679
$feature_array[FREF] = $feature_hash->{ref};
680
$feature_array[FSTART] = $feature_hash->{start};
681
$feature_array[FSTOP] = $feature_hash->{stop};
682
$feature_array[FSOURCE] = $feature_hash->{source};
683
$feature_array[FMETHOD] = $feature_hash->{method};
684
$feature_array[FSCORE] = $feature_hash->{score};
685
$feature_array[FSTRAND] = $feature_hash->{strand};
686
$feature_array[FPHASE ] = $feature_hash->{phase};
687
$feature_array[GCLASS] = $feature_hash->{gclass};
688
$feature_array[GNAME] = $feature_hash->{gname};
689
$feature_array[TSTART] = $feature_hash->{tstart};
690
$feature_array[TSTOP] = $feature_hash->{tstop};
691
$feature_array[FID] = $feature_hash->{feature_id};
692
$feature_array[GID] = $feature_hash->{group_id};
694
$features_array_array[$feature_count] = \@feature_array;
697
return \@features_array_array;
700
sub _matching_typelist{
273
701
my ($feature_method,$feature_source,$typelist) = @_;
275
702
foreach (@$typelist) {
276
703
my ($search_method,$search_source) = @$_;
277
704
next if $search_method ne $feature_method;
278
705
next if defined($search_source) && $search_source ne $feature_source;
711
sub _matching_attributes{
712
my ($feature_attributes,$attributes) = @_ ;
713
foreach (keys %$attributes) {
714
return 0 if !_match_all_attr_in_feature($_,$attributes->{$_},$feature_attributes)
720
sub _match_all_attr_in_feature{
721
my ($attr_name,$attr_value,$feature_attributes) = @_;
722
for my $attr (@$feature_attributes) {
723
my ($feature_attr_name,$feature_attr_value) = @$attr ;
724
next if ($attr_name ne $feature_attr_name || $attr_value ne $feature_attr_value);
285
731
sub do_initialize { 1; }
286
732
sub setup_load { }
287
733
sub finish_load { 1; }
734
sub get_feature_by_group_id{ 1; }
added
removed
Bio/DB/GFF/Adaptor/memory.pm
