File Coverage

blib/lib/Parser/FIT.pm

Criterion	Covered	Total	%
statement	205	245	83.6
branch	49	76	64.4
condition	5	9	55.5
subroutine	26	30	86.6
pod	4	11	36.3
total	289	371	77.9

package Parser::FIT;

use strict;
use warnings;
use Carp qw/croak carp/;
use feature 'state';
use Math::BigInt;
use Parser::FIT::Profile;

#require "Profile.pm";

our $VERSION = 0.04;

sub new {
	my $class = shift;
	my %options = @_;

	my $ref = {
		_DEBUG => 0,
		header => {},
		body => {},
		globalMessages => [],
		localMessages => [],
		records => 0,
		fh => undef,
		buffer => "",
		headerLength => 0,
		totalBytesRead => 0,
		messageHandlers => {},
	};

	if(exists $options{on}) {
		$ref->{messageHandlers} = $options{on};
	}

	if(exists $options{debug} && $options{debug}) {
		$ref->{_DEBUG} = 1;
	}

	bless($ref, $class);

	return $ref;
}

sub parse {
	my $self = shift;
	my $file = shift;

	croak "No file given to parse()!" unless($file);

	$self->_debug("Parsing '$file'");

	croak "File '$file' doesn't exist!" if(!-f $file);

	$self->_debug("Opening file");
	open(my $input, "<", $file) or croak "Error opening '$file': $!";
	binmode($input);

	$self->parse_fh($input);
}

sub parse_fh {
	my $self = shift;
	my $input = shift;

	unless(ref $input eq "GLOB") {
		die "parse_fh requires an opened filehandle as param!";
	}


	$self->{fh} = $input;
	my $header = $self->_read_header();
	$self->{header} = $self->_parse_header($header);
	#my $dataBody = $self->_readBytes($self->{header}->{dataLength});
	$self->_parse_data_records();
	#$self->_parse_crc();

	close($input);
}

sub parse_data {
	my $self = shift;
	my $data = shift;

	open(my $fh, "<", \$data) or die "Error opening scalar as file: $!";
	binmode($fh);

	return $self->parse_fh($fh);
}

sub _read_header {
	my $self = shift;

	my $headerLengthByte = $self->_readBytes(1);
	my $headerLength = unpack("c", $headerLengthByte);
	$self->{headerLength} = $headerLength;

	# The 1-Byte headerLength field is included in the total header length
	my $headerWithoutLengthByte = $headerLength - 1;

	my $header = $self->_readBytes($headerWithoutLengthByte);

	return $header;
}

sub _parse_header {
	my $self = shift;
	my $header = shift;

	my ($protocolVersion, $profile, $dataLength, $fileMagic, $crc);

	my $headerLength = length $header;

	if($headerLength == 13) {
		($protocolVersion, $profile, $dataLength, $fileMagic, $crc) = unpack("c s I! a4 s", $header);
	}
	elsif($headerLength == 11) {
		($protocolVersion, $profile, $dataLength, $fileMagic) = unpack("c s I! a4", $header);

		# Short header has no CRC value
		$crc = undef;
	}
	else {
		croak "Invalid headerLength=${headerLength}! Don't know how to handle this.";
	}

	croak "File either corrupted or not a real FIT file! (Missing magic '.FIT' string in header)" unless($fileMagic eq ".FIT");

	$self->_debug("ProtocolVersion: $protocolVersion");
	$self->_debug("Profile: $profile");
	$self->_debug("DataLength: $dataLength Bytes");
	$self->_debug("FileMagic: $fileMagic");
	$self->_debug("CRC: " . (defined($crc) ? $crc : "N/A"));

	my $headerInfo = {
		protocolVersion => $protocolVersion,
		profile => $profile,
		dataLength => $dataLength,
		crc => $crc,
		eof => $self->{headerLength} + $dataLength,
	};

	return $headerInfo;
}

sub _parse_record_header {
	my $self = shift;
	my $recordHeader = shift;

	return {
		# Bit 7 inidcates a normal header (=0) or "something else"
		isNormalHeader => (($recordHeader & (1<<7)) == 0),
		# Bit 6 indicates a definition msg
		isDefinitionMessage => (($recordHeader & (1<<6)) > 0),
		# Bit 5 indicates "developer data flag"
		isDeveloperData => (($recordHeader & (1<<5)) > 0),
		# Bit 4 is reserved
		# Bits 3-0 define the localMessageType
		localMessageType => $recordHeader & 0xF,
	};
}

sub _parse_data_records {
	my $self = shift;

	$self->_debug("Parsing Data Records");
	while($self->{totalBytesRead} < $self->{header}->{eof}) {

		my ($recordHeaderByte) = unpack("c", $self->_readBytes(1));
		$self->_debug("HeaderBytes in Binary: " . sprintf("%08b", $recordHeaderByte));
		my $header = $self->_parse_record_header($recordHeaderByte);

		if($header->{isNormalHeader}) {
			if($header->{isDefinitionMessage}) {
				$self->_debug("Record definition header for LocalMessageType=" . $header->{localMessageType});
				$self->_parse_definition_message($header);
			}
			else {
				my $parseResult = $self->_parse_local_message_record($header);

				if(!defined $parseResult) {
					$self->_debug("Skipping record for unknown LocalMessageType=" . $header->{localMessageType});
					next;
				}

				$self->_debug("Processed record for LocalMessageType=" . $header->{localMessageType});

				$self->emitRecord($parseResult->{messageType}, $parseResult->{fields});

				$self->{records}++;
			}
		}
	}
	$self->_debug("DataRecords finished! Found a total of " . $self->{records} . " Records");
}

sub on {
	my $self = shift;
	my $msgType = shift;
	my $handler = shift;

	my $msgHandlers = $self->{messageHandlers};

	if($handler) {
		$msgHandlers->{$msgType} = $handler;
	}
	else {
		delete $msgHandlers->{$msgType};
	}
}

sub emitRecord {
	my $self = shift;
	my ($msgType, $msgData) = @_;

	if($msgType eq 'field_description') {
		$self->_debug("Encountered a field_description message");
		$self->attachDeveloperDataToGlobalMessage($msgData);
	}

	if(my $handler = $self->getHandler($msgType)) {
		$handler->($msgData);
	}

	if(my $allHandler = $self->getHandler("_any")) {
		$allHandler->($msgType, $msgData);
	}
}

sub attachDeveloperDataToGlobalMessage {
	my $self = shift;
	my $msgData = shift;

	my $globalMessageid = $msgData->{native_mesg_num}->{value};
	my $fieldId = $msgData->{field_definition_number}->{value};

	my $globalMessage = $self->_get_global_message_type($globalMessageid);
	$globalMessage->{developer_data}->{$fieldId} = {
		id => $fieldId,
		name => $msgData->{field_name}->{value},
		units => $msgData->{units}->{value},
		baseType => $self->_get_base_type($msgData->{fit_base_type_id}->{value} & 15),
		type => undef,
		# Developer data ist never scaled/offsetted!
		offset => undef,
		scale => undef,
	};
}

sub getHandler {
	my $self = shift;
	my $msgType = shift;

	if(!$msgType) {
		die "cannot get a handler for an unknown msgType!";
	}

	if(exists $self->{messageHandlers}->{$msgType}) {
		return $self->{messageHandlers}->{$msgType};
	}

	return undef;
}

sub _parse_definition_message {
	my $self = shift;
	my $header = shift;
	my $localMessageType = $header->{localMessageType};

	my $data = $self->_readBytes(5);
	my ($reserved, $arch, $globalMessageId, $fields) = unpack("ccsc", $data);

	my $globalMessageType = $self->_get_global_message_type($globalMessageId);

	$self->_debug("DefinitionMessageHeader:");
	$self->_debug("Arch: $arch - GlobalMessage: " . (defined $globalMessageType ? $globalMessageType->{name} : "") . " ($globalMessageId) - #Fields: $fields");
	carp "BigEndian isn't supported so far!" if($arch == 1);

	my ($messageFields, $devMsgFields, $recordLength) = ([], [], 0);
	my @fields;

	if(defined $globalMessageType) {
		($messageFields, $recordLength) = $self->_parse_defintion_message_fields($globalMessageType->{fields}, $fields);
	}

	if($header->{isDeveloperData}) {
		($devMsgFields, my $devRecordLength) = $self->parseDeveloperDataDefinitionMessage($globalMessageType);
		$recordLength += $devRecordLength;
	}

	my $combinedDataFields = [@$messageFields, @$devMsgFields];

	my $localMessage = {
		size => $recordLength,
		dataFields => $combinedDataFields,
		globalMessage => $globalMessageType,,
		unpackTemplate => join("", map { $_->{baseType}->{packTemplate} . '[' . $_->{arrayLength} . ']' } @$combinedDataFields),
		isDeveloperMessage => $header->{isDeveloperData},
		isUnknownMessage => !defined $globalMessageType,
	};

	$self->{localMessages}->[$localMessageType] = $localMessage;

	$self->_debug("Following Record length: " . $localMessage->{size} . " bytes");
}

sub parseDeveloperDataDefinitionMessage {
	my $self = shift;
	my $globalMessageType = shift;

	my $developerFieldCount = unpack("C", $self->_readBytes(1));

	my ($devMsgFields, $devRecordLength) = $self->_parse_defintion_message_fields($globalMessageType->{developer_data}, $developerFieldCount);

	foreach my $field (@$devMsgFields) {
		# BaseTypes of Dev Data is not included in the 3bytes of the definition message but in the field_description message which introduces the dev data
		# Therefore we simply overwrite the wrongly extracted BaseType from the definition message with the correct one.
		$field->{baseType} = $field->{fieldDescriptor}->{baseType};
	}

	return ($devMsgFields, $devRecordLength);
}

sub _parse_defintion_message_fields {
	my $self = shift;
	my $fieldDefinitions = shift;
	my $numberOfFields = shift;

	my $recordLength = 0;

	my @dataFields;

	foreach(1..$numberOfFields) {
		my $fieldDefinitionData = $self->_readBytes(3); # Every Field has 3 Bytes
		my ($fieldDefinition, $size, $baseTypeData)  = unpack("Ccc", $fieldDefinitionData);
		my ($baseTypeEndian, $baseTypeNumber) = ($baseTypeData & 128, $baseTypeData & 15);
		my $baseType = $self->_get_base_type($baseTypeNumber);
		my $fieldDescriptor = $fieldDefinitions->{$fieldDefinition};

		if(!defined $fieldDescriptor) {
			$fieldDescriptor = {
				isUnkownField => 1,
				name => ""
			};
		}

		my $fieldName = $fieldDescriptor->{name};
		$self->_debug("FieldDefinition: Nr: $fieldDefinition (" . $fieldName . "), Size: $size, BaseType: " . $baseType->{name} . " ($baseTypeNumber), BaseTypeEndian: $baseTypeEndian");
		$recordLength += $size;

		push(@dataFields, { baseType => $baseType, storageSize => $size, isArray => $size > $baseType->{size}, arrayLength => $size/$baseType->{size}, fieldDescriptor => $fieldDescriptor });
	}

	return (\@dataFields, $recordLength);
}

sub _global_message_id_to_name {
	my $self = shift;
	my $globalMessageId = shift;

	# Manufacterer specific message types
	if($globalMessageId >= 0xFF00) {
			return "mfg_range_min";
	}

	state $globalMessageNames = {
		0 => "file_id",
		1 => "capabilities",
		2 => "device_settings",
		3 => "user_profile",
		4 => "hrm_profile",
		5 => "sdm_profile",
		6 => "bike_profile",
		7 => "zones_target",
		8 => "hr_zone",
		9 => "power_zone",
		10 => "met_zone",
		12 => "sport",
		15 => "goal",
		18 => "session",
		19 => "lap",
		20 => "record",
		21 => "event",
		23 => "device_info",
		26 => "workout",
		27 => "workout_step",
		28 => "schedule",
		30 => "weight_scale",
		31 => "course",
		32 => "course_point",
		33 => "totals",
		34 => "activity",
		35 => "software",
		37 => "file_capabilities",
		38 => "mesg_capabilities",
		39 => "field_capabilities",
		49 => "file_creator",
		51 => "blood_pressure",
		53 => "speed_zone",
		55 => "monitoring",
		72 => "training_file",
		78 => "hrv",
		80 => "ant_rx",
		81 => "ant_tx",
		82 => "ant_channel_id",
		101 => "length",
		103 => "monitoring_info",
		105 => "pad",
		106 => "slave_device",
		127 => "connectivity",
		128 => "weather_conditions",
		129 => "weather_alert",
		131 => "cadence_zone",
		132 => "hr",
		142 => "segment_lap",
		145 => "memo_glob",
		148 => "segment_id",
		149 => "segment_leaderboard_entry",
		150 => "segment_point",
		151 => "segment_file",
		158 => "workout_session",
		159 => "watchface_settings",
		160 => "gps_metadata",
		161 => "camera_event",
		162 => "timestamp_correlation",
		164 => "gyroscope_data",
		165 => "accelerometer_data",
		167 => "three_d_sensor_calibration",
		169 => "video_frame",
		174 => "obdii_data",
		177 => "nmea_sentence",
		178 => "aviation_attitude",
		184 => "video",
		185 => "video_title",
		186 => "video_description",
		187 => "video_clip",
		188 => "ohr_settings",
		200 => "exd_screen_configuration",
		201 => "exd_data_field_configuration",
		202 => "exd_data_concept_configuration",
		206 => "field_description",
		207 => "developer_data_id",
		208 => "magnetometer_data",
		209 => "barometer_data",
		210 => "one_d_sensor_calibration",
		225 => "set",
		227 => "stress_level",
		258 => "dive_settings",
		259 => "dive_gas",
		262 => "dive_alarm",
		264 => "exercise_title",
		268 => "dive_summary",
		285 => "jump",
		317 => "climb_pro",
	};

	if(exists $globalMessageNames->{$globalMessageId}) {
		return $globalMessageNames->{$globalMessageId};
	}
	else {
		return undef;
	}
}

sub getLocalMessageById {
	my $self = shift;
	my $localMessageId = shift;

	my $localMessage = $self->{localMessages}->[$localMessageId];

	if(!defined $localMessage) {
		die "Encountered a record  localMessageId=$localMessageId which was not introduced by a definition message!";
	}

	return $localMessage;
}

sub _get_global_message_type {
	my $self = shift;

	my $globalMessageName = $self->_global_message_id_to_name(shift);

	if(!defined $globalMessageName) {
		return undef;
	}

	if(exists $Parser::FIT::Profile::PROFILE->{$globalMessageName}) {
		return $Parser::FIT::Profile::PROFILE->{$globalMessageName};
	}
	else {
		return undef;
	}
}

sub _parse_local_message_record {
	my $self = shift;
	my $header = shift;

	my $localMessageId = $header->{localMessageType};
	my $localMessage = $self->getLocalMessageById($localMessageId);

	my $recordLength = $localMessage->{size};
	my $record = $self->_readBytes($recordLength);

	# skip unknown messages (the _readBytes above is correct, since we need to "remove" the bytes from the stream)
	if($localMessage->{isUnknownMessage}) {
		return undef;
	}

	my $unpackTemplate = $localMessage->{unpackTemplate};
	my @rawFields = unpack($unpackTemplate, $record);

	my %result;

	my $fieldCount = scalar @{$localMessage->{dataFields}};
	for(my $i = 0; $i < $fieldCount; $i++) {
		my $localMessageField = $localMessage->{dataFields}->[$i];
		my $rawValue = $rawFields[$i];

		my $fieldDescriptor = $localMessageField->{fieldDescriptor};
		my $fieldName = $fieldDescriptor->{name};

		if($fieldDescriptor->{isUnkownField}) {
			next;
		}

		my $postProcessedValue = $self->postProcessRawValue($rawValue, $fieldDescriptor);

		$result{$fieldName} = {
			value => $postProcessedValue,
			rawValue => $rawValue,
			fieldDescriptor => $fieldDescriptor,
		};
	}

	return {
		messageType => $localMessage->{globalMessage}->{name},
		fields => \%result
	};
}

sub postProcessRawValue {
	my $self = shift;
	my $rawValue = shift;
	my $fieldDescriptor = shift;

	if(defined $fieldDescriptor->{scale}) {
		$rawValue /= $fieldDescriptor->{scale};
	}

	if(defined $fieldDescriptor->{offset}) {
		$rawValue -= $fieldDescriptor->{offset};
	}

	if(defined $fieldDescriptor->{unit} && $fieldDescriptor->{unit} eq "semicircles") {
		state $semicirclesToDegreesConversionRate = 180 / 2**31;
		$rawValue *= $semicirclesToDegreesConversionRate;
	}

	if(defined $fieldDescriptor->{type} && $fieldDescriptor->{type} eq "date_time") {
		state $fitEpocheOffset = 631065600;
		$rawValue += $fitEpocheOffset;
	}

	return $rawValue;
}

sub _get_base_type {
	my $self = shift;
	my $index = shift;

	# See "Table 7. FIT Base Types and Invalid Values" at https://developer.garmin.com/fit/protocol/
	my $types = [
		{
			name => "enum",
			size => 1,
			invalid => 0xff,
			packTemplate => "c",
		},
		{
			name => "sint8",
			size => 1,
			invalid => 0x7f,
			packTemplate => "c"
		},
		{
			name => "uint8",
			size => 1,
			invalid => 0xff,
			packTemplate => "C",

		},
		{
			name => "sint16",
			size => 2,
			invalid => 0x7fff,
			packTemplate => "s",
		},
		{
			name => "uint16",
			size => 2,
			invalid => 0xffff,
			packTemplate => "S"
		},
		{
			name => "sint32",
			size => 4,
			invalid => 0x7fffffff,
			packTemplate => "l"
		},
		{
			name => "uint32",
			size => 4,
			invalid => 0xffffffff,
			packTemplate => "L",
		},
		{
			name => "string",
			size => 1,
			invalid => 0x00,
			packTemplate => "Z"
		},
		{
			name => "float32",
			size => 4,
			invalid => 0xffffffff,
			packTemplate => "f"
		},
		{
			name => "float64",
			size => 8,
			invalid => Math::BigInt->new("0xffffffffffffffff"),
			packTemplate => "d",
		},
		{
			name => "uint8z",
			size => 1,
			invalid => 0x00,
			packTemplate => "c"
		},
		{
			name => "uint16z",
			size => 2,
			invalid => 0x0000,
			packTemplate => "S",
		},
		{
			name => "uint32z",
			size => 4,
			invalid => 0x00000000,
			packTemplate => "L"
		},
		{
			name => "byte",
			size => 1,
			invalid => 0xFF,
			packTemplate => "C",
		},
		{
			name => "sint64",
			size => 8,
			invalid => Math::BigInt->new("0x7fffffffffffffff"),
			packTemplate => "q",
		},
		{
			name => "uint64",
			size => 8,
			invalid => Math::BigInt->new("0xffffffffffffffff"),
			packTemplate => "Q",
		},
		{
			name => "uint64z",
			size => 8,
			invalid => 0x0000000000000000,
			packTemplate => "Q",
		}
	];

	if($index >= @{$types}) {
		die "Invalid index=$index for BaseTypeLookup!";
	}

	return $types->[$index];
}

sub _parse_crc {
	# TODO implement this one...some time :D
}

sub _debug {
	my $self = shift;
	if($self->{_DEBUG}) {
		print "[FIT.pm DEBUG] ", @_;
		print "\n";
	}
}

sub _readBytes {
	my $self = shift;
	my $num = shift;

	$self->{totalBytesRead} += $num;
	my $buffer;
	my $bytesRead = read($self->{fh}, $buffer, $num);
	# TODO error handling based on bytesRead
	return $buffer;
}





1;


__END__