view release on metacpan or  search on metacpan

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

        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 ) {
                $end_pt = Geo::TCX::Trackpoint->new( $1 );
                push @lap_endpoints, $end_pt
            }
            # since split removed tags sometimes at ^ of string for other at $
            # let's remove them all and add back
            $lap_tags[$i] =~ s,</?Lap>,,g;
            $lap_tags[$i] =~ s,^,<Lap>,g;
            $lap_tags[$i] =~ s,$,</Lap>,g
        }
        my $track_str;
        if ( $xml_str =~ m,(<Track>.*</Track>),s ) {
            $track_str = $1;
        }

        my $t = Geo::TCX::Track->new( $track_str );
        if (@lap_tags ==1)  { $track_tags[0] = $track_str }
        else  {
            my ($t1, $t2);
            for my $i (0 .. $#lap_tags ) {
                if ($i < $#lap_tags) {
                    ($t1, $t2) = $t->split_at_point_closest_to( $lap_endpoints[$i] );
                    push @track_tags, $t1->xml_string;
                    $t = $t2
                } else { push @track_tags, $t->xml_string } # ie don't split the last track portion
            }
        }

        my $lap;
        for my  $i (0 .. $#lap_tags) {
            my ($lapstring, $last_point_previous_lap);
            $lapstring = $lap_tags[$i] . $track_tags[$i];
            $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
        }
    }

    my $n = $o->laps;
    die "cannot find any laps, must not be a *.tcx file or str" unless $n;
    print "\nFound " . $n, ($n > 1 ? " Laps": " Lap"), "\n\n";
    $o->{_txt} = $txt;                      # only for debugging
    $o->set_wd( $opts{work_dir} || $opts{wd} );
    return $o
}

=head2 Constructor Methods (object)

=over 4

=item activity_to_course( key/values )

returns a new <Geo::TCX> instance as a course, based on the current activity.

All I<key/values> are optional:

Z<>    C<< lap => I<#> >>: converts lap number I<#> to a course, dropping all other laps. All laps are converted if C<lap> is omitted.
Z<>    C<< course_name => I<$string> >>: the name for the course. The name will be the lap's C<StartTime> if a value is not specified.
Z<>    C<< filename => I<$filename> >>: will call C<set_filename()> with this value.
Z<>    C<< work_dir => I<$work_dir> >>: if omitted, it will be set to the same as that of the current object.

=back

=cut

sub activity_to_course {
    my $clone = shift->clone;
    my %opts = @_;
    croak 'this instance is already a course' if $clone->is_course;
    my $wd = $opts{work_dir} || $opts{wd} || $clone->set_wd();

    my (@laps, $course);
    @laps = $opts{lap} ? ($opts{lap}) : (1 .. $clone->laps);

    for my $lap_i (@laps) {
        my $str = $clone->save_laps( [ $lap_i ], nosave => 1, course => 1, course_name => $opts{course_name} );
        my $course_i = Geo::TCX->new( \$str, work_dir => $wd );
        if ( defined $course ) {
            push @{ $course->{Laps} }, $course_i->lap(1)
        } else { $course = $course_i }
    }
    $course->set_filename( $opts{filename} );