view release on metacpan or  search on metacpan

lib/Geo/FIT.pm  view on Meta::CPAN

sub FIT_UINT8Z() {10;}
sub FIT_UINT16Z() {11;}
sub FIT_UINT32Z() {12;}
sub FIT_BYTE() {13;}
sub FIT_SINT64() {14;}
sub FIT_UINT64() {15;}
sub FIT_UINT64Z() {16;}
sub FIT_BASE_TYPE_MAX() {FIT_UINT64Z;}

my ($rechd_offset_compressed_timestamp_header, $rechd_mask_compressed_timestamp_header,
    $rechd_offset_cth_local_message_type, $rechd_length_cth_local_message_type,
    $rechd_mask_cth_local_message_type, $rechd_length_cth_timestamp, $rechd_mask_cth_timestamp,
    $rechd_offset_definition_message, $rechd_mask_definition_message, $rechd_offset_devdata_message,
    $rechd_mask_devdata_message, $rechd_length_local_message_type, $rechd_mask_local_message_type,
    $cthd_offset_local_message_type, $cthd_length_local_message_type, $cthd_mask_local_message_type,
    $cthd_length_time_offset, $cthd_mask_time_offset
    );

$rechd_offset_compressed_timestamp_header =  7;
$rechd_mask_compressed_timestamp_header   =  1 << $rechd_offset_compressed_timestamp_header;
$rechd_offset_cth_local_message_type      =  5;
$rechd_length_cth_local_message_type      =  2;
$rechd_mask_cth_local_message_type        =  ((1 << $rechd_length_cth_local_message_type) - 1) << $rechd_offset_cth_local_message_type;
$rechd_length_cth_timestamp               =  $rechd_offset_cth_local_message_type;
$rechd_mask_cth_timestamp                 =  (1 << $rechd_length_cth_timestamp) - 1;
$rechd_offset_definition_message          =  6;
$rechd_mask_definition_message            =  1 << $rechd_offset_definition_message;
$rechd_offset_devdata_message             =  5;
$rechd_mask_devdata_message               =  1 << $rechd_offset_devdata_message;
$rechd_length_local_message_type          =  4;
$rechd_mask_local_message_type            =  (1 << $rechd_length_local_message_type) - 1;
$cthd_offset_local_message_type           =  5;
$cthd_length_local_message_type           =  2;
$cthd_mask_local_message_type             =  (1 << $cthd_length_local_message_type) - 1;
$cthd_length_time_offset                  =  5;
$cthd_mask_time_offset                    =  (1 << $cthd_length_time_offset) - 1;

my ($defmsg_min_template, $defmsg_min_length);
$defmsg_min_template  =  'C C C S C';
$defmsg_min_length    =  length(pack($defmsg_min_template));

my ($deffld_template, $deffld_length, $deffld_mask_endian_p, $deffld_mask_type);
$deffld_template       =  'C C C';
$deffld_length         =  length(pack($deffld_template));
$deffld_mask_endian_p  =  1 << 7;
$deffld_mask_type      =  (1 << 5) - 1;

my ($devdata_min_template, $devdata_min_length, $devdata_deffld_template, $devdata_deffld_length);
$devdata_min_template    = 'C';
$devdata_min_length      = length(pack($devdata_min_template));
$devdata_deffld_template = 'C C C';
$devdata_deffld_length   = length(pack($deffld_template));

my @invalid = (0xFF) x ($deffld_mask_type + 1);
$invalid[FIT_SINT8] = 0x7F;
$invalid[FIT_SINT16] = 0x7FFF;
$invalid[FIT_UINT16] = 0xFFFF;
$invalid[FIT_SINT32] = 0x7FFFFFFF;
$invalid[FIT_UINT32] = 0xFFFFFFFF;
$invalid[FIT_STRING] = $invalid[FIT_UINT8Z] = $invalid[FIT_UINT16Z] = $invalid[FIT_UINT32Z] = $invalid[FIT_UINT64Z] = 0;
#$invalid[FIT_FLOAT32] = NaN;
#$invalid[FIT_FLOAT64] = NaN;
$invalid[FIT_FLOAT32] = unpack('f', pack('V', 0xFFFFFFFF));
$invalid[FIT_FLOAT64] = unpack('d', pack('V V', 0xFFFFFFFF, 0xFFFFFFFF));

my ($big_int_base32, $sint64_2c_mask, $sint64_2c_base, $sint64_2c_sign);

if (defined $uint64_invalid) {
    $invalid[FIT_UINT64] = $uint64_invalid;
    $invalid[FIT_SINT64] = eval '0x7FFFFFFFFFFFFFFF';
} else {
    $invalid[FIT_UINT64] = Math::BigInt->new('0xFFFFFFFFFFFFFFFF');
    $invalid[FIT_SINT64] = Math::BigInt->new('0x7FFFFFFFFFFFFFFF');
    $big_int_base32 = Math::BigInt->new('0x100000000');
    $sint64_2c_mask = Math::BigInt->new('0xFFFFFFFFFFFFFFFF');
    $sint64_2c_base = Math::BigInt->new('0x10000000000000000');
    $sint64_2c_sign = Math::BigInt->new('0x1000000000000000');
}

sub packfilter_uint64_big_endian {
    my @res = $_[0]->bdiv($big_int_base32);
    @res;
}

sub packfilter_uint64_little_endian {
    my @res = $_[0]->bdiv($big_int_base32);
    @res[1, 0];
}

my $my_endian = unpack('L', pack('N', 1)) == 1 ? 1 : 0;

*packfilter_uint64 = $my_endian ? \&packfilter_uint64_big_endian : \&packfilter_uint64_little_endian;

sub unpackfilter_uint64_big_endian {
    my ($hi, $lo) = @_;
    Math::BigInt->new($hi)->blsft(32)->badd($lo);
}

sub unpackfilter_uint64_little_endian {
    &unpackfilter_uint64_big_endian(@_[1, 0]);
}

*unpackfilter_uint64 = $my_endian ? \&unpackfilter_uint64_big_endian : \&unpackfilter_uint64_little_endian;

sub packfilter_sint64_big_endian {
    if ($_[0]->bcmp(0) < 0) {
        &packfilter_uint64_big_endian($sint64_2c_mask->band($sint64_2c_base->badd($_[0])));
    } else {
        &packfilter_uint64_big_endian($_[0]);
    }
}

sub packfilter_sint64_little_endian {
    if ($_[0]->bcmp(0) < 0) {
        &packfilter_uint64_little_endian($sint64_2c_mask->band($sint64_2c_base->badd($_[0])));
    } else {
        &packfilter_uint64_little_endian($_[0]);
    }
}

*packfilter_sint64 = $my_endian ? \&packfilter_sint64_big_endian : \&packfilter_sint64_little_endian;

lib/Geo/FIT.pm  view on Meta::CPAN

            if ($packfactor[$type] > 1) {
                push @pi, $type, $i_array_t, $c, $i_array;
                $c *= $packfactor[$type];
            }

            $desc{template} .= $c if $c > 1;
            $i_array_t += $c;
        }

        $desc{devdata_nfields} = $nfields;
        $self->error(join(' / ', @emsg)) if (@emsg);
    }

    $desc{endian_converter} = \@cvt if @cvt;
    $desc{packfilter_index} = \@pi if @pi;
    $desc{message_length} = $i_string;
    $desc{array_length} = $i_array;
    $self->offset($e);
    return 1
}

sub endian_convert {
    my ($self, $cvt, $buffer, $i) = @_;
    my $j;

    for ($j = 4 ; $j < @$cvt ; $j += 5) {
        my ($b, $size, $c) = @$cvt[$j - 2, $j - 1, $j];

        for ($b += $i ; $c > 0 ; $b += $size, --$c) {
            my @v = unpack($cvt->[$j - 3], substr($$buffer, $b, $size));
            my ($k, $l);

            for ($k = 0, $l = $#v ; $k < $l ; ++$k, --$l) {
                @v[$k, $l] = @v[$l, $k];
            }
            substr($$buffer, $b, $size) = pack($cvt->[$j - 4], @v);
        }
    }
}

sub last_timestamp {
    my $self = shift;
    if (@_) {
        $self->{last_timestamp} = $_[0];
    } else {
        $self->{last_timestamp};
    }
}

sub fetch_data_message {
    my ($self, $desc) = @_;
    my $buffer = $self->buffer;

    if ( $self->_buffer_needs_updating( $desc->{message_length} ) ) {
        $self->fill_buffer or return undef
    }
    $self->endian_convert($desc->{endian_converter}, $self->buffer, $self->offset) if ref $desc->{endian_converter} eq 'ARRAY';

    my $i = $self->offset;
    # unpack('f'/'d', ...) unpacks to NaN
    my @v = unpack($desc->{template}, substr($$buffer, $i, $desc->{message_length}));

    if (ref $desc->{packfilter_index} eq 'ARRAY') {
        my $piv = $desc->{packfilter_index};
        my ($i, $j);
        my @v_t = @v;

        @v = ($v_t[0]);

        for ($i = 1, $j = 3 ; $j < @$piv ; $j += 4) {
            my ($type, $i_array_t, $c, $i_array) = @$piv[($j - 3) .. $j];
            my $delta = $packfactor[$type];

            $i < $i_array_t and push @v, @v_t[$i .. ($i_array_t - 1)];
            $i = $i_array_t + $c * $delta;

            for (; $i_array_t < $i ; $i_array_t += $delta) {
                push @v, $unpackfilter[$type]->(@v_t[$i_array_t .. ($i_array_t + $delta - 1)]);
            }
        }
    }

    $self->offset($i + $desc->{message_length});

    my $cb = $desc->{callback};

    my $ret_val;
    if (ref $cb eq 'ARRAY') {
        $v[0] & $rechd_mask_compressed_timestamp_header and push @v, $self->last_timestamp + ($v[0] & $rechd_mask_cth_timestamp);
        $ret_val = $cb->[0]->($self, $desc, \@v, @$cb[1 .. $#$cb]);
    } else {
        $ret_val = 1;
    }
    return $ret_val
}

sub pack_data_message {
    my ($self, $desc, $v) = @_;
    my $drop_devdata = $self->drop_developer_data;

    if ($drop_devdata && ($desc->{message_name} eq 'developer_data_id' || $desc->{message_name} eq 'field_description')) {
        '';
    } else {
        my $rv = $v;

        if (ref $desc->{packfilter_index} eq 'ARRAY') {
            my @v = ($v->[0]);
            my $piv = $desc->{packfilter_index};
            my ($i, $j);

            for ($i = 1, $j = 3 ; $j < @$piv ; $j += 4) {
                my ($type, $i_array_t, $c, $i_array) = @$piv[($j - 3) .. $j];

                $i < $i_array and push @v, @$v[$i .. ($i_array - 1)];
                $i = $i_array + $c;

                for (; $i_array < $i ; ++$i_array) {
                    push @v, $packfilter[$type]->($v->[$i_array]);
                }
            }