view release on metacpan or  search on metacpan

lib/MS/Reader/MzML/Record.pm  view on Meta::CPAN

package MS::Reader::MzML::Record;

use strict;
use warnings;

use parent qw/MS::Reader::XML::Record::CV/;

use Compress::Zlib;
use MIME::Base64;
use List::Util qw/first/;
use MS::CV qw/:MS :UO/;

# Abbreviate some constants
use constant NUMPRESS_LIN  => MS_MS_NUMPRESS_LINEAR_PREDICTION_COMPRESSION;
use constant NUMPRESS_PIC  => MS_MS_NUMPRESS_POSITIVE_INTEGER_COMPRESSION;
use constant NUMPRESS_SLOF => MS_MS_NUMPRESS_SHORT_LOGGED_FLOAT_COMPRESSION;

sub _pre_load {

    my ($self) = @_;

    # Lookup tables to quickly check elements
    $self->{_make_named_array} = {
        cvParam   => 'accession',
        userParam => 'name',
    };
    $self->{_make_anon_array} = { map {$_ => 1} qw/
        referenceableParamGroupRef
        product
        binaryDataArray
        precursor
        selectedIon
        scanWindow
        scan
    / };

}

sub _get_raw {

    my ($self, $array) = @_;
    return decode_base64( $array->{binary}->{pcdata} );

}

sub _get_code {

    my ($self, $array) = @_;

    return defined $self->param(MS_32_BIT_FLOAT,   ref => $array) ? 'f<'
         : defined $self->param(MS_64_BIT_FLOAT,   ref => $array) ? 'd<'
         : defined $self->param(MS_32_BIT_INTEGER, ref => $array) ? 'l<'
         : defined $self->param(MS_64_BIT_INTEGER, ref => $array) ? 'q<'
         : undef;

}

# binary arrays are only decoded upon request, to increase parse speed
sub get_array {

    my ($self, $acc) = @_;


    # fetch from cache if exists
    if ($self->{__use_cache} && exists $self->{__memoized}->{arrays}->{$acc}) {
        my $ret = $self->{__memoized}->{arrays}->{$acc};
        # return hash in array context, or first data array else
        return wantarray ? @$ret : $ret->[1];
    }

    # Find data array reference by CV accession
    my @arrays = grep {defined $self->param($acc, ref => $_)}
        @{ $self->{binaryDataArrayList}->{binaryDataArray} };

    my @ret;

    for my $array (@arrays) {

        # Extract metadata necessary to unpack array
        my $raw = $self->_get_raw($array);
        my $is_zlib  = 0;
        my $numpress = 'none';
        if (! defined $self->param(MS_NO_COMPRESSION, ref => $array) ) {
            $is_zlib  = defined $self->param(MS_ZLIB_COMPRESSION, ref => $array);
            $numpress
                = defined $self->param(NUMPRESS_LIN,  ref => $array) ? 'np-lin'
                : defined $self->param(NUMPRESS_PIC,  ref => $array) ? 'np-pic'
                : defined $self->param(NUMPRESS_SLOF, ref => $array) ? 'np-slof'
                : 'none';
            # Compression type (or lack thereof) MUST be specified!
            die "Uknown compression scheme (no known schemes specified) ??"
                if (! $is_zlib && $numpress eq 'none');
        }
        my $code = $self->_get_code($array);
    
        die "floating point precision required if numpress not used"
            if (! defined $code && $numpress eq 'none');

        my $data = _decode_raw(
            $raw,
            $code,
            $is_zlib,