view release on metacpan or  search on metacpan

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

  use Geo::TCX;

=head1 DESCRIPTION

C<Geo::TCX> enables the parsing and editing of TCX activity and course files, including those from FIT files. TCX files follow an XML schema developed by Garmin and common to its GPS sports devices. Among other methods, the module enables laps from a...

FIT activity and course files are supported provided that L<Geo::FIT> is installed and that the C<fit2tcx.pl> script it provides appears on the user's path.

The module supports files containing a single Activity or Course. Database files consisting of multiple activities or courses are not supported.

The documentation regarding TCX files in general uses the terms history and activity quite interchangeably, including in the user guides such as the one for the Garmin Edge device the author of this module is using. In C<Geo::TCX>, the terms Activity...

=cut

use Geo::TCX::Lap;
use File::Basename;
use File::Temp qw/ tempfile /;
use IPC::System::Simple qw(run capture);
use Cwd qw(cwd abs_path);
use Carp qw(confess croak cluck);

=head2 Constructor Methods (class)

=over 4

=item new( $filename or $str_ref, work_dir => $working_directory )

loads and returns a new Geo::TCX instance using the I<$filename> supplied as first argument or a string reference equivalent to the xml tags of a *.tcx file.

  $o = Geo::TCX->new('2022-08-11-10-27-15.tcx');
or
  $o = Geo::TCX->new( \'...');

The optional C<work_dir> (or C<wd> for short) specifies where to save any working files, such as with the save_laps() method. It can be supplied as a relative path or as an absolute path. If C<work_dir> is omitted, it is set based on the path of the ...

=back

=cut

sub new {
    my ($proto, $first_arg) = (shift, shift);
    my %opts = @_;
    my $o  = {};
    my $class = ref($proto) || $proto;
    bless($o, $class);

    my $txt;
    if (ref( $first_arg ) eq 'SCALAR') {
        $txt = $$first_arg
    } else {
        my $fname = $first_arg;
        my $file_to_read = $first_arg;
        croak 'first argument must be a filename' unless -f $fname;

        if ($fname =~ /(?i:\.fit$)/) {
            my ($fh, $tmp_fname) = tempfile();
            _convert_fit_to_tcx( $fname, $tmp_fname );
            $file_to_read = $tmp_fname;
            $fname =~ s/(?i:.fit)$/.tcx/
        }
        $txt = do { local(@ARGV, $/) = $file_to_read; <> };
        $o->set_filename($fname)
    }

    $txt =~ s,\r,,g;                               # if it's a windows file
    $txt =~ s,>\s+<,><,g;
    $o->{tag_creator} = $1 if $txt =~ s/(<Creator.*<\/Creator>)//;

    # Activities/Activity  - are as recorded  by an EDGE 705 device
    # Courses/Course       - are as converted by an EDGE 705 device from an Activity

    $o->{tag_xml_version} = $1             if $txt =~ /(<.xml version[^>]*>)/;
    $o->{tag_trainingcenterdatabase} = $1  if $txt =~ /(<TrainingCenterDatabase.*<\/TrainingCenterDatabase>)/;
    $o->{tag_activities} = $1              if $txt =~ /(<Activities.*<\/Activities>)/;
    $o->{tag_activity} = $1                if $txt =~ /(<Activity.*<\/Activity>)/;
    $o->{tag_courses} = $1                 if $txt =~ /(<Courses.*<\/Courses>)/;
    $o->{tag_course} = $1                  if $txt =~ /(<Course(?!s).*<\/Course>)/;

    # Id seems only for Activities/Activity...
    if ($o->{tag_activity}) {
        $o->{tag_id} = $1            if $o->{tag_activity} =~ /<Activity.*<Id>(.*)<\/Id>/;
        $o->{tag_activity_type} = $1 if $o->{tag_activity} =~ /<Activity Sport="([^"]+)"/;
    }

    # ... and Name only for Courses/Course
    if ($o->{tag_course}) {
        # will pick up device name under Creator if we are not specific about the Course tag
        $o->{tag_name} = $1 if $o->{tag_course} =~ /<Course.*<Name>(.*)<\/Name>/
    }

    $o->{tag_author}  = $1  if $txt =~ /(<Author.*<\/Author>)/;
    $o->_parse_author_tag if $o->{tag_author};

    my @Lap;
    if ( $o->{tag_activity} ) {
        my $i = 0;
        my $lap;
        while ( $o->{tag_activity} =~ /(\<Lap StartTime=.*?\>.*?\<\/Lap\>)/g ) {
            my ($lapstring, $last_point_previous_lap);
            $lapstring = $1;
            $last_point_previous_lap = $lap->trackpoint(-1) if $i > 0;
            $lap = Geo::TCX::Lap->new($lapstring, ++$i, $last_point_previous_lap);
            push @{ $o->{Laps} }, $lap
        }
    }
    if ( $o->{tag_course} ) {
        # in Courses, data is structured as <Lap>...</Lap><Lap>...</Lap><Track>...</Track><Track>...</Track>
        # actually, not sure just seem like it's one long ... track, not multiple ones, which complicates things
        my $xml_str = $o->{tag_course};

        my (@lap_tags, @lap_endpoints, @track_tags);

        if ( $xml_str =~ m,(<Lap>.*</Lap>),s ) {
            my $str = $1;
            @lap_tags = split(/(?s)<\/Lap>\s*<Lap>/, $str );
            if (@lap_tags == 0) { push @lap_tags, $str }
        }

        for my $i (0 .. $#lap_tags) {
            my ($end_pos, $end_pt);
            if ( $lap_tags[$i] =~ m,<EndPosition>(.*)</EndPosition>,s ) {