lib/Bio/DB/GFF/Adaptor/memory.pm

   1 package Bio::DB::GFF::Adaptor::memory;
   2
   3 =head1 NAME
   4
   5 Bio::DB::GFF::Adaptor::memory -- Bio::DB::GFF database adaptor for in-memory databases
   6
   7 =head1 SYNOPSIS
   8
   9   use Bio::DB::GFF;
  10   my $db = Bio::DB::GFF->new(-adaptor=> 'memory',
  11                              -gff    => 'my_features.gff',
  12                              -fasta  => 'my_dna.fa'
  13                             );
  14
  15 or
  16
  17   my $db = Bio::DB::GFF->new(-adaptor=>'memory');
  18   $db->load_gff_file('my_features.gff');
  19   $db->load_fasta_file('my_dna.fa');
  20
  21 See L<Bio::DB::GFF> for other methods.
  22
  23 =head1 DESCRIPTION
  24
  25 This adaptor implements an in-memory version of Bio::DB::GFF.  It can be used to
  26 store and retrieve SHORT GFF files. It inherits from Bio::DB::GFF.
  27
  28 =head1 CONSTRUCTOR
  29
  30 Use Bio::DB::GFF-E<gt>new() to construct new instances of this class.
  31 Three named arguments are recommended:
  32
  33    Argument         Description
  34
  35    -adaptor         Set to "memory" to create an instance of this class.
  36    -gff             Read the indicated file or directory of .gff file.
  37    -fasta           Read the indicated file or directory of fasta files.
  38    -dir             Indicates a directory containing .gff and .fa files
  39
  40 If you use the -dir option and the indicated directory is writable by
  41 the current process, then this library will create a FASTA file index
  42 that greatly diminishes the memory usage of this module.
  43
  44 Alternatively you may create an empty in-memory object using just the
  45 -adaptor=E<gt>'memory' argument and then call the load_gff_file() and
  46 load_fasta_file() methods to load GFF and/or sequence
  47 information. This is recommended in CGI/mod_perl/fastCGI environments
  48 because these methods do not modify STDIN, unlike the constructor.
  49
  50 =head1 METHODS
  51
  52 See L<Bio::DB::GFF> for inherited methods.
  53
  54 =head1 BUGS
  55
  56 none ;-)
  57
  58 =head1 SEE ALSO
  59
  60 L<Bio::DB::GFF>, L<bioperl>
  61
  62 =head1 AUTHOR
  63
  64 Shuly Avraham E<lt>avraham@cshl.orgE<gt>.
  65
  66 Copyright (c) 2002 Cold Spring Harbor Laboratory.
  67
  68 This library is free software; you can redistribute it and/or modify
  69 it under the same terms as Perl itself.
  70
  71 =cut
  72
  73 use strict;
  74 # AUTHOR: Shulamit Avraham
  75 # This module needs to be cleaned up and documented
  76
  77 # Bio::DB::GFF::Adaptor::memory --  in-memory db adaptor
  78 # implements the low level handling of data which stored in memory.
  79 # This adaptor implements a specific in memory schema that is compatible with Bio::DB::GFF.
  80 # Inherits from Bio::DB::GFF.
  81
  82
  83 use Bio::DB::GFF::Util::Rearrange; # for rearrange()
  84 use Bio::DB::GFF::Adaptor::memory::iterator;
  85 use File::Basename 'dirname';
  86 use Bio::DB::GFF::Adaptor::memory::feature_serializer qw(@hash2array_map);
  87
  88
  89 use constant MAX_SEGMENT => 1_000_000_000;  # the largest a segment can get
  90
  91 use base qw(Bio::DB::GFF);
  92
  93 sub new {
  94   my $class = shift ;
  95   my ($file,$fasta,$dbdir,$preferred_groups) = rearrange([
  96                                                           [qw(GFF FILE)],
  97                                                           'FASTA',
  98                                                           [qw(DSN DB DIR DIRECTORY)],
  99                                                           'PREFERRED_GROUPS',
 100                                                          ],@_);
 101
 102   # fill in object
 103   my $self = bless{ data => [] },$class;
 104   $self->preferred_groups($preferred_groups) if defined $preferred_groups;
 105   $file  ||= $dbdir;
 106   $fasta ||= $dbdir;
 107   $self->load_gff($file)             if $file;
 108   $self->load_or_store_fasta($fasta) if $fasta;
 109   return $self;
 110 }
 111
 112 sub load_or_store_fasta {
 113   my $self  = shift;
 114   my $fasta = shift;
 115   if ((-f $fasta && -w dirname($fasta))
 116       or
 117       (-d $fasta && -w $fasta)) {
 118     require Bio::DB::Fasta;
 119     my $dna_db = eval {Bio::DB::Fasta->new($fasta);}
 120       or warn "$@\nCan't open sequence file(s). Use -gff instead of -dir if you wish to load features without sequence.\n";
 121     $dna_db && $self->dna_db($dna_db);
 122   } else {
 123     $self->load_fasta($fasta);
 124   }
 125 }
 126
 127 sub dna_db {
 128   my $self = shift;
 129   my $d    = $self->{dna_db};
 130   $self->{dna_db} = shift if @_;
 131   $d;
 132 }
 133
 134 sub insert_sequence {
 135   my $self = shift;
 136   my($id,$offset,$seq) = @_;
 137   $self->{dna}{$id} .= $seq;
 138 }
 139
 140 # low-level fetch of a DNA substring given its
 141 # name, class and the desired range.
 142 sub get_dna {
 143   my $self = shift;
 144   my ($id,$start,$stop,$class) = @_;
 145   if (my $dna_db = $self->dna_db) {
 146     return $dna_db->seq($id,$start=>$stop);
 147   }
 148   return '' unless $self->{dna};
 149
 150   return $self->{dna}{$id} unless defined $start || defined $stop;
 151   $start = 1 if !defined $start;
 152
 153   my $reversed = 0;
 154   if ($start > $stop) {
 155     $reversed++;
 156     ($start,$stop) = ($stop,$start);
 157   }
 158   my $dna = substr($self->{dna}{$id},$start-1,$stop-$start+1);
 159   if ($reversed) {
 160     $dna =~ tr/gatcGATC/ctagCTAG/;
 161     $dna = reverse $dna;
 162   }
 163
 164   $dna;
 165 }
 166
 167 sub setup_load {
 168   my $self = shift;
 169   $self->{tmp}  = {};
 170   $self->{data} = [];
 171   1;
 172 }
 173
 174 sub finish_load {
 175   my $self = shift;
 176   my $idx  = 0;
 177   foreach my $arrayref (values %{$self->{tmp}}) {
 178     foreach (@$arrayref) {$_->{feature_id} = $idx++; }
 179     push @{$self->{data}},@$arrayref;
 180   }
 181   1;
 182 }
 183
 184 # this method loads the feature as a hash into memory -
 185 # keeps an array of features-hashes as an in-memory db
 186 sub load_gff_line {
 187   my $self = shift;
 188   my $feature_hash  = shift;
 189   $feature_hash->{strand} = ''  if $feature_hash->{strand} && $feature_hash->{strand} eq '.';
 190   $feature_hash->{phase}  = ''  if $feature_hash->{phase}  && $feature_hash->{phase} eq '.';
 191   $feature_hash->{gclass} = 'Sequence' unless length $feature_hash->{gclass} > 0;
 192   # sort by group please
 193   push @{$self->{tmp}{$feature_hash->{gclass},$feature_hash->{gname}}},$feature_hash;
 194 }
 195
 196 # given sequence name, return (reference,start,stop,strand)
 197 sub get_abscoords {
 198   my $self = shift;
 199   my ($name,$class,$refseq) = @_;
 200   my %refs;
 201   my $regexp;
 202
 203   if ($name =~ /[*?]/) {  # uh oh regexp time
 204     $name = quotemeta($name);
 205     $name =~ s/\\\*/.*/g;
 206     $name =~ s/\\\?/.?/g;
 207     $regexp++;
 208   }
 209
 210   # Find all features that have the requested name and class.
 211   # Sort them by reference point.
 212   for my $feature (@{$self->{data}}) {
 213
 214     my $no_match_class_name;
 215     my $empty_class_name;
 216     my $class_matches = !defined($feature->{gclass}) ||
 217       length($feature->{gclass}) == 0 ||
 218         $feature->{gclass} eq $class;
 219
 220     if (defined $feature->{gname}) {
 221       my $matches = $class_matches
 222         && ($regexp ? $feature->{gname} =~ /$name/i : lc($feature->{gname}) eq lc($name));
 223       $no_match_class_name = !$matches;  # to accomodate Shuly's interesting logic
 224     }
 225
 226     else{
 227       $empty_class_name = 1;
 228     }
 229
 230     if ($no_match_class_name){
 231       my $feature_attributes = $feature->{attributes};
 232       my $attributes = {Alias => $name};
 233       if (!$self->_matching_attributes($feature_attributes,$attributes)){
 234         next;
 235       }
 236     }
 237
 238     push @{$refs{$feature->{ref}}},$feature;
 239   }
 240
 241   # find out how many reference points we recovered
 242   if (! %refs) {
 243     $self->error("$name not found in database");
 244     return;
 245   }
 246
 247   # compute min and max
 248   my ($ref) = keys %refs;
 249   my @found = @{$refs{$ref}};
 250   my ($strand,$start,$stop);
 251
 252   my @found_segments;
 253   foreach my $ref (keys %refs) {
 254     next if defined($refseq) and lc($ref) ne lc($refseq);
 255     my @found = @{$refs{$ref}};
 256     my ($strand,$start,$stop,$name);
 257     foreach (@found) {
 258       $strand ||= $_->{strand};
 259       $strand = '+' if $strand && $strand eq '.';
 260       $start  = $_->{start} if !defined($start) || $start > $_->{start};
 261       $stop   = $_->{stop}  if !defined($stop)  || $stop  < $_->{stop};
 262       $name ||= $_->{gname};
 263     }
 264     push @found_segments,[$ref,$class,$start,$stop,$strand,$name];
 265
 266   }
 267
 268   return \@found_segments;
 269 }
 270
 271 sub search_notes {
 272   my $self = shift;
 273   my ($search_string,$limit) = @_;
 274
 275   $search_string =~ tr/*?//d;
 276
 277   my @results;
 278   my @words = map {quotemeta($_)} $search_string =~ /(\w+)/g;
 279   my $search = join '|',@words;
 280
 281   for my $feature (@{$self->{data}}) {
 282     next unless defined $feature->{gclass} && defined $feature->{gname}; # ignore NULL objects
 283     next unless $feature->{attributes};
 284     my @attributes = @{$feature->{attributes}};
 285     my @values     = map {$_->[1]} @attributes;
 286     my $value      = "@values";
 287     my $matches    = 0;
 288     for my $w (@words) {
 289       my @hits = $value =~ /($w)/ig;
 290       $matches += @hits;
 291     }
 292     next unless $matches;
 293
 294     my $relevance = 10 * $matches;
 295     my $featname = Bio::DB::GFF::Featname->new($feature->{gclass}=>$feature->{gname});
 296     my $note;
 297     $note    = join ' ',map {$_->[1]} grep {$_->[0] eq 'Note'}                @{$feature->{attributes}};
 298     $note   .= join ' ',grep /$search/,map {$_->[1]} grep {$_->[0] ne 'Note'} @{$feature->{attributes}};
 299     my $type = Bio::DB::GFF::Typename->new($feature->{method},$feature->{source});
 300     push @results,[$featname,$note,$relevance,$type];
 301     last if defined $limit && @results >= $limit;
 302   }
 303
 304   #added result filtering so that this method returns the expected results
 305   #this section of code used to be in GBrowse's do_keyword_search method
 306
 307   my $match_sub = 'sub {';
 308   foreach (split /\s+/,$search_string) {
 309     $match_sub .= "return unless \$_[0] =~ /\Q$_\E/i; ";
 310   }
 311   $match_sub .= "};";
 312   my $match = eval $match_sub;
 313
 314   my @matches = grep { $match->($_->[1]) } @results;
 315
 316   return @matches;
 317 }
 318
 319 sub _delete_features {
 320   my $self        = shift;
 321   my @feature_ids = sort {$b<=>$a} @_;
 322   my $removed = 0;
 323   foreach (@feature_ids) {
 324     next unless $_ >= 0 && $_ < @{$self->{data}};
 325     $removed += defined splice(@{$self->{data}},$_,1);
 326   }
 327   $removed;
 328 }
 329
 330 sub _delete {
 331   my $self = shift;
 332   my $delete_spec = shift;
 333   my $ranges      = $delete_spec->{segments} || [];
 334   my $types       = $delete_spec->{types}    || [];
 335   my $force       = $delete_spec->{force};
 336   my $range_type  = $delete_spec->{range_type};
 337
 338   my $deleted = 0;
 339   if (@$ranges) {
 340     my @args = @$types ? (-type=>$types) : ();
 341     push @args,(-range_type => $range_type);
 342     my %ids_to_remove = map {$_->id => 1} map {$_->features(@args)} @$ranges;
 343     $deleted = $self->delete_features(keys %ids_to_remove);
 344   } elsif (@$types) {
 345     my %ids_to_remove = map {$_->id => 1} $self->features(-type=>$types);
 346     $deleted = $self->delete_features(keys %ids_to_remove);
 347   } else {
 348     $self->throw("This operation would delete all feature data and -force not specified")
 349       unless $force;
 350     $deleted = @{$self->{data}};
 351     @{$self->{data}} = ();
 352   }
 353   $deleted;
 354 }
 355
 356 # attributes -
 357
 358 # Some GFF version 2 files use the groups column to store a series of
 359 # attribute/value pairs.  In this interpretation of GFF, the first such
 360 # pair is treated as the primary group for the feature; subsequent pairs
 361 # are treated as attributes.  Two attributes have special meaning:
 362 # "Note" is for backward compatibility and is used for unstructured text
 363 # remarks.  "Alias" is considered as a synonym for the feature name.
 364 # If no name is provided, then attributes() returns a flattened hash, of
 365 # attribute=>value pairs.
 366
 367 sub do_attributes{
 368   my $self = shift;
 369   my ($feature_id,$tag) = @_;
 370   my $attr ;
 371
 372   #my $feature = ${$self->{data}}[$feature_id];
 373   my $feature = $self->_basic_features_by_id($feature_id);
 374
 375   my @result;
 376   for my $attr (@{$feature->{attributes}}) {
 377     my ($attr_name,$attr_value) = @$attr ;
 378     if (defined($tag) && lc($attr_name) eq lc($tag)){push @result,$attr_value;}
 379     elsif (!defined($tag)) {push @result,($attr_name,$attr_value);}
 380   }
 381   return @result;
 382 }
 383
 384
 385 #sub get_feature_by_attribute{
 386 sub _feature_by_attribute{
 387   my $self = shift;
 388   my ($attributes,$callback) = @_;
 389   $callback || $self->throw('must provide a callback argument');
 390   my $count = 0;
 391   my $feature_id = -1;
 392   my $feature_group_id = undef;
 393
 394   for my $feature (@{$self->{data}}) {
 395
 396     $feature_id++;
 397     for my $attr (@{$feature->{attributes}}) {
 398       my ($attr_name,$attr_value) = @$attr ;
 399       #there could be more than one set of attributes......
 400       foreach (keys %$attributes) {
 401         if (lc($_) eq lc($attr_name) && lc($attributes->{$_}) eq lc($attr_value)) {
 402           $callback->($self->_hash_to_array($feature));
 403           $count++;
 404         }
 405       }
 406     }
 407   }
 408
 409 }
 410
 411
 412 # This is the low-level method that is called to retrieve GFF lines from
 413 # the database.  It is responsible for retrieving features that satisfy
 414 # range and feature type criteria, and passing the GFF fields to a
 415 # callback subroutine.
 416
 417 sub get_features{
 418   my $self = shift;
 419   my $count = 0;
 420   my ($search,$options,$callback) = @_;
 421
 422   my $found_features;
 423
 424   $found_features = $self->_get_features_by_search_options($search,$options);
 425
 426   # only true if the sort by group option was specified
 427   @{$found_features} = sort {lc("$a->{gclass}:$a->{gname}") cmp lc("$b->{gclass}:$b->{gname}")}
 428     @{$found_features} if $options->{sort_by_group} ;
 429
 430   for my $feature (@{$found_features}) {  # only true if the sort by group option was specified
 431     $count++;
 432     $callback->(
 433                 $self->_hash_to_array($feature)
 434                );
 435   }
 436
 437   return $count;
 438 }
 439
 440
 441 # Low level implementation of fetching a named feature.
 442 # GFF annotations are named using the group class and name fields.
 443 # May return zero, one, or several Bio::DB::GFF::Feature objects.
 444
 445 =head2 _feature_by_name
 446
 447  Title   : _feature_by_name
 448  Usage   : $db->get_features_by_name($name,$class,$callback)
 449  Function: get a list of features by name and class
 450  Returns : count of number of features retrieved
 451  Args    : name of feature, class of feature, and a callback
 452  Status  : protected
 453
 454 This method is used internally.  The callback arguments are those used
 455 by make_feature().
 456
 457 =cut
 458
 459 sub _feature_by_name {
 460   my $self = shift;
 461   my ($class,$name,$location,$callback) = @_;
 462   $callback || $self->throw('must provide a callback argument');
 463   my $count = 0;
 464   my $regexp;
 465
 466   if ($name =~ /[*?]/) {  # uh oh regexp time
 467     $name = quotemeta($name);
 468     $name =~ s/\\\*/.*/g;
 469     $name =~ s/\\\?/.?/g;
 470     $regexp++;
 471   }
 472
 473   for my $feature (@{$self->{data}}) {
 474     next unless ($regexp && $feature->{gname} =~ /$name/i) || lc($feature->{gname})  eq lc($name);
 475     next if defined($feature->{gclass}) && length($feature->{gclass}) > 0 && $feature->{gclass} ne $class;
 476
 477     if ($location) {
 478       next if $location->[0] ne $feature->{ref};
 479       next if $location->[1] && $location->[1] > $feature->{stop};
 480       next if $location->[2] && $location->[2] < $feature->{start};
 481     }
 482     $count++;
 483     $callback->($self->_hash_to_array($feature),0);
 484   }
 485   return $count;
 486 }
 487
 488 # Low level implementation of fetching a feature by it's id.
 489 # The id of the feature as implemented in the in-memory db, is the location of the
 490 # feature in the features hash array.
 491 sub _feature_by_id{
 492   my $self = shift;
 493   my ($ids,$type,$callback) = @_;
 494   $callback || $self->throw('must provide a callback argument');
 495
 496   my $feature_group_id = undef;
 497
 498   my $count = 0;
 499   if ($type eq 'feature'){
 500     for my $feature_id (@$ids){
 501       my $feature = $self->_basic_features_by_id($feature_id);
 502       $callback->($self->_hash_to_array($feature)) if $callback;
 503       $count++;
 504     }
 505   }
 506 }
 507
 508 sub _basic_features_by_id{
 509   my $self = shift;
 510   my ($ids) = @_;
 511
 512   $ids = [$ids] unless ref $ids =~ /ARRAY/;
 513
 514   my @result;
 515   for my $feature_id (@$ids){
 516           push @result, ${$self->{data}}[$feature_id];
 517   }
 518   return wantarray() ? @result : $result[0];
 519 }
 520
 521 # This method is similar to get_features(), except that it returns an
 522 # iterator across the query.
 523 # See Bio::DB::GFF::Adaptor::memory::iterator.
 524
 525 sub get_features_iterator {
 526   my $self = shift;
 527   my ($search,$options,$callback) = @_;
 528   $callback || $self->throw('must provide a callback argument');
 529
 530   my $results = $self->_get_features_by_search_options($search,$options);
 531   my $results_array = $self->_convert_feature_hash_to_array($results);
 532
 533   return Bio::DB::GFF::Adaptor::memory::iterator->new($results_array,$callback);
 534 }
 535
 536
 537 # This method is responsible for fetching the list of feature type names.
 538 # The query may be limited to a particular range, in
 539 # which case the range is indicated by a landmark sequence name and
 540 # class and its subrange, if any.  These arguments may be undef if it is
 541 # desired to retrieve all feature types.
 542
 543 # If the count flag is false, the method returns a simple list of
 544 # Bio::DB::GFF::Typename objects.  If $count is true, the method returns
 545 # a list of $name=>$count pairs, where $count indicates the number of
 546 # times this feature occurs in the range.
 547
 548 sub get_types {
 549   my $self = shift;
 550   my ($srcseq,$class,$start,$stop,$want_count,$typelist) = @_;
 551
 552   my(%result,%obj);
 553
 554   for my $feature (@{$self->{data}}) {
 555     my $feature_start = $feature->{start};
 556     my $feature_stop  = $feature->{stop};
 557     my $feature_ref   = $feature->{ref};
 558     my $feature_class = $feature->{class};
 559     my $feature_method = $feature->{method};
 560     my $feature_source = $feature->{source};
 561
 562     if (defined $srcseq){
 563       next unless lc($feature_ref) eq lc($srcseq);
 564     }
 565
 566     if (defined $class){
 567       next unless defined $feature_class && $feature_class eq $class ;
 568     }
 569
 570      # the requested range should OVERLAP the retrieved features
 571      if (defined $start or defined $stop) {
 572       $start = 1           unless defined $start;
 573       $stop  = MAX_SEGMENT unless defined $stop;
 574       next unless $feature_stop >= $start && $feature_start <= $stop;
 575     }
 576
 577     if (defined $typelist && @$typelist){
 578       next unless $self->_matching_typelist($feature_method,$feature_source,$typelist);
 579     }
 580
 581     my $type = Bio::DB::GFF::Typename->new($feature_method,$feature_source);
 582     $result{$type}++;
 583     $obj{$type} = $type;
 584
 585   }   #end features loop
 586
 587   return $want_count ? %result : values %obj;
 588 }
 589
 590 sub classes {
 591   my $self = shift;
 592   my %classes;
 593   for my $feature (@{$self->{data}}) {
 594     $classes{$feature->{gclass}}++;
 595   }
 596   my @classes = sort keys %classes;
 597   return @classes;
 598 }
 599
 600 # Internal method that performs a search on the features array,
 601 # sequentialy retrieves the features, and performs a check on each feature
 602 # according to the search options.
 603 sub _get_features_by_search_options{
 604   my $count = 0;
 605   my ($self, $search,$options) = @_;
 606   my ($rangetype,$refseq,$class,$start,$stop,$types,$sparse,$order_by_group,$attributes) =
 607     (@{$search}{qw(rangetype refseq refclass start stop types)},
 608      @{$options}{qw(sparse sort_by_group ATTRIBUTES)}) ;
 609
 610   my @found_features;
 611   my $data = $self->{data};
 612
 613   my $feature_id       = -1 ;
 614   my $feature_group_id = undef;
 615
 616   for my $feature (@{$data}) {
 617
 618     $feature_id++;
 619
 620     my $feature_start = $feature->{start};
 621     my $feature_stop  = $feature->{stop};
 622     my $feature_ref   = $feature->{ref};
 623
 624     if (defined $refseq){
 625       next unless lc($feature_ref) eq lc($refseq);
 626     }
 627
 628      if (defined $start or defined $stop) {
 629       $start = 0               unless defined($start);
 630       $stop  = MAX_SEGMENT     unless defined($stop);
 631
 632       if ($rangetype eq 'overlaps') {
 633         next unless $feature_stop >= $start && $feature_start <= $stop;
 634       } elsif ($rangetype eq 'contains') {
 635         next unless $feature_start >= $start && $feature_stop <= $stop;
 636       } elsif ($rangetype eq 'contained_in') {
 637         next unless $feature_start <= $start && $feature_stop >= $stop;
 638       } else {
 639         next unless $feature_start == $start && $feature_stop == $stop;
 640       }
 641
 642     }
 643
 644     my $feature_source = $feature->{source};
 645     my $feature_method = $feature->{method};
 646
 647     if (defined $types && @$types){
 648       next unless $self->_matching_typelist($feature_method,$feature_source,$types);
 649     }
 650
 651     my $feature_attributes = $feature->{attributes};
 652     if (defined $attributes){
 653       next unless $self->_matching_attributes($feature_attributes,$attributes);
 654     }
 655
 656     # if we get here, then we have a feature that meets the criteria.
 657     # Then we just push onto an array
 658     # of found features and continue.
 659
 660     my $found_feature = $feature ;
 661     $found_feature->{feature_id} = $feature_id;
 662     $found_feature->{group_id} = $feature_group_id;
 663     push @found_features,$found_feature;
 664   }
 665
 666   return \@found_features;
 667 }
 668
 669
 670 sub _hash_to_array {
 671   my ($self,$feature_hash) = @_;
 672   my @array = @{$feature_hash}{@hash2array_map};
 673   return wantarray ? @array : \@array;
 674 }
 675
 676 # this subroutine is needed for convertion of the feature from hash to array in order to
 677 # pass it to the callback subroutine
 678 sub _convert_feature_hash_to_array{
 679   my ($self, $feature_hash_array) = @_;
 680   my @features_array_array = map {scalar $self->_hash_to_array($_)} @$feature_hash_array;
 681   return \@features_array_array;
 682 }
 683
 684 sub _matching_typelist{
 685   my ($self, $feature_method,$feature_source,$typelist) = @_;
 686   foreach (@$typelist) {
 687          my ($search_method,$search_source) = @$_;
 688          next if lc($search_method) ne lc($feature_method);
 689          next if defined($search_source) && lc($search_source) ne lc($feature_source);
 690          return 1;
 691   }
 692   return 0;
 693 }
 694
 695 sub _matching_attributes {
 696   my ($self, $feature_attributes,$attributes) = @_ ;
 697   foreach (keys %$attributes) {
 698     return 0 if !_match_all_attr_in_feature($_,$attributes->{$_},$feature_attributes)
 699   }
 700   return 1;
 701 }
 702
 703 sub _match_all_attr_in_feature{
 704   my ($attr_name,$attr_value,$feature_attributes) = @_;
 705   for my $attr (@$feature_attributes) {
 706       my ($feature_attr_name,$feature_attr_value) = @$attr ;
 707       next if ($attr_name ne $feature_attr_name || $attr_value ne $feature_attr_value);
 708       return 1;
 709   }
 710   return 0;
 711 }
 712
 713
 714 sub do_initialize { 1; }
 715 sub get_feature_by_group_id{ 1; }
 716
 717 1;
 718