File Coverage

blib/lib/Bio/JBrowse/Store/NCList/ArrayRepr.pm

Criterion	Covered	Total	%
statement	82	95	86.3
branch	12	18	66.6
condition	9	17	52.9
subroutine	15	18	83.3
pod	0	11	0.0
total	118	159	74.2

package Bio::JBrowse::Store::NCList::ArrayRepr;
BEGIN {
  $Bio::JBrowse::Store::NCList::ArrayRepr::AUTHORITY = 'cpan:RBUELS';
}
{
  $Bio::JBrowse::Store::NCList::ArrayRepr::VERSION = '0.1';
}
#ABSTRACT: compact array-based serialization of hashrefs

use strict;
use warnings;
use Carp;


sub new {
    my ($class, $classes) = @_;
    $classes ||= [];

    # fields is an array of (map from attribute name to attribute index)
    my @fields;
    for my $attributes ( map $_->{attributes}, @$classes ) {
        my $field_index = 1;
        push @fields, { map { $_ => $field_index++ } @$attributes };
    }

    my $self = {
        fields  => \@fields,
        classes => $classes,
        classes_by_fingerprint => {
            map { join( '-', @{$_->{attributes}} ) => $_ } @$classes
        }
    };

    bless $self, $class;
    return $self;
}

# convert a feature hashref into array representation
sub convert_hashref {
    my ( $self, $hashref ) = @_;
    delete $hashref->{seq_id};
    my $class = $self->getClass( $hashref );
    my $a = [ $class->{index}, map { $hashref->{$_} } @{$class->{attributes}} ];
    if( defined( my $sub_idx = $class->{attr_idx}{subfeatures} ) ) {
        $a->[$sub_idx] = [ map { $self->convert_hashref( $_ ) } @{$a->[$sub_idx]} ];
    }
    return $a;
}

# convert a stream of hashrefs into a stream of arrays
sub convert_hashref_stream {
    my ( $self, $in_stream ) = @_;
    return sub {
        my $f = $in_stream->();
        return unless $f;
        return $self->convert_hashref( $f );
    };
}

my %skip_field = map { $_ => 1 } qw( start end );
sub getClass {
    my ( $self, $feature ) = @_;

    my @attrs = keys %$feature;
    my $attr_fingerprint = join '-', @attrs;

    return $self->{classes_by_fingerprint}{$attr_fingerprint} ||= do {
        my @attributes = ( 'start', 'end', ( grep !$skip_field{$_}, @attrs ) );
        my $i = 0;
        my $class = {
            attributes => \@attributes,
            attr_idx => { map { $_ => ++$i } @attributes },
            # assumes that if a field is an array for one feature, it will be for all of them
            isArrayAttr => { map { $_ => 1 } grep ref($feature->{$_}) eq 'ARRAY', @attrs }
        };
        push @{ $self->{fields} }, $class->{attr_idx};
        push @{ $self->{classes} }, $class;
        $class->{index} = $#{ $self->{classes} };
        $class;
    };
}


sub get {
    my ($self, $obj, $attr) = @_;
    my $fields = $self->{'fields'}->[$obj->[0]];
    if (defined($fields) && defined($fields->{$attr})) {
        return $obj->[$fields->{$attr}];
    } else {
        my $cls = $self->{'classes'}->[$obj->[0]];
        return unless defined($cls);
        my $adhocIndex = $#{$cls->{'attributes'}} + 2;
        if (($adhocIndex > $#{$obj})
            or (not defined($obj->[$adhocIndex]->{$attr})) ) {
            if (defined($cls->{'proto'})
                and (defined($cls->{'proto'}->{$attr})) ) {
                return $cls->{'proto'}->{$attr};
            }
            return undef;
        }
        return $obj->[$adhocIndex]->{$attr};
    }
}

sub fastGet {
    # this method can be used if the attribute is guaranteed to be in
    # the attributes array for the object's class
    my ($self, $obj, $attr) = @_;
    return $obj->[ $self->{fields}->[$obj->[0]]->{$attr} ];
}

sub set {
    my ($self, $obj, $attr, $val) = @_;
    my $fields = $self->{'fields'}->[$obj->[0]];
    if (defined($fields) && defined($fields->{$attr})) {
        $obj->[$fields->{$attr}] = $val;
    } else {
        my $cls = $self->{'classes'}->[$obj->[0]];
        return unless defined($cls);
        my $adhocIndex = $#{$cls->{'attributes'}} + 2;
        if ($adhocIndex > $#{$obj}) {
            $obj->[$adhocIndex] = {}
        }
        $obj->[$adhocIndex]->{$attr} = $val;
    }
}

sub descriptor {
    [ map { { attributes => $_->{attributes}, isArrayAttr => $_->{isArrayAttr} } } @{shift->{classes}} ]
}

sub fastSet {
    # this method can be used if the attribute is guaranteed to be in
    # the attributes array for the object's class
    my ($self, $obj, $attr, $val) = @_;
    $obj->[$self->{'fields'}->[$obj->[0]]->{$attr}] = $val;
}

sub makeSetter {
    my ($self, $attr) = @_;
    return sub {
        my ($obj, $val) = @_;
        $self->set($obj, $attr, $val);
    };
}

sub makeGetter {
    my ($self, $attr) = @_;
    return sub {
        my ($obj) = @_;
        return $self->get($obj, $attr);
    };
}

1;

__END__