view release on metacpan or  search on metacpan

Ace/Sequence/FeatureList.pm  view on Meta::CPAN

package Ace::Sequence::FeatureList;

use overload '""' => 'asString';

sub new {
  local $^W = 0;  # to prevent untrackable uninitialized variable warning
  my $package =shift;
  my @lines = split("\n",$_[0]);
  my (%parsed);
  foreach (@lines) {
    next if m!^//!;
    my ($minor,$major,$count) = split "\t";
    next unless $count > 0;
    $parsed{$major}{$minor} += $count;
    $parsed{_TOTAL} += $count;
  }
  return bless \%parsed,$package;
}

# no arguments, scalar context -- count all features
# no arguments, array context  -- list of major types
# 1 argument, scalar context   -- count of major type
# 1 argument, array context    -- list of minor types
# 2 arguments                  -- count of subtype
sub types {
  my $self = shift;
  my ($type,$subtype) = @_;
  my $count = 0;

  unless ($type) {
    return wantarray ? grep !/^_/,keys %$self : $self->{_TOTAL};
  }

  unless ($subtype) {
    return keys %{$self->{$type}} if wantarray;
    foreach (keys %{$self->{$type}}) {
      $count += $self->{$type}{$_};
    }
    return $count;
  }
  
  return $self->{$type}{$subtype};
}

# human-readable summary table
sub asString {
  my $self = shift;
  my ($type,$subtype);
  for my $type ( sort $self->types() ) {
    for my $subtype (sort $self->types($type) ) {
      print join("\t",$type,$subtype,$self->{$type}{$subtype}),"\n";
    }
  }
}

1;

=head1 NAME

Ace::Sequence::FeatureList - Lightweight Access to Features

=head1 SYNOPSIS

    # get a megabase from the middle of chromosome I
    $seq = Ace::Sequence->new(-name   => 'CHROMOSOME_I,
                              -db     => $db,
			      -offset => 3_000_000,
			      -length => 1_000_000);

    # find out what's there
    $list = $seq->feature_list;

    # Scalar context: count all the features
    $feature_count = $list->types;

    # Array context: list all the feature types
    @feature_types = $list->types;