diff options
Diffstat (limited to 'lib/Travelynx/Model/Journeys.pm')
| -rwxr-xr-x | lib/Travelynx/Model/Journeys.pm | 355 |
1 files changed, 305 insertions, 50 deletions
diff --git a/lib/Travelynx/Model/Journeys.pm b/lib/Travelynx/Model/Journeys.pm index 0fb663e..bce475f 100755 --- a/lib/Travelynx/Model/Journeys.pm +++ b/lib/Travelynx/Model/Journeys.pm @@ -4,16 +4,16 @@ package Travelynx::Model::Journeys; # # SPDX-License-Identifier: AGPL-3.0-or-later -use GIS::Distance; -use List::MoreUtils qw(after_incl before_incl); - use strict; use warnings; use 5.020; use utf8; use DateTime; +use DateTime::Format::Strptime; +use GIS::Distance; use JSON; +use List::MoreUtils qw(after_incl before_incl first_index last_index); my %visibility_itoa = ( 100 => 'public', @@ -50,6 +50,8 @@ sub epoch_to_dt { ); } +# TODO turn into a travelynx helper called from templates so that +# loc_handle is available for localization sub min_to_human { my ( $self, $minutes ) = @_; @@ -183,20 +185,44 @@ sub add { } if ( $opt{route} ) { + my $parser = DateTime::Format::Strptime->new( + pattern => '%d.%m.%Y %H:%M', + locale => 'de_DE', + time_zone => 'Europe/Berlin' + ); my @unknown_stations; + my $prev_epoch = 0; + for my $station ( @{ $opt{route} } ) { + my $ts; + my %station_data; + if ( $station + =~ m{ ^ (?<stop> [^@]+? ) \s* [@] \s* (?<timestamp> .+ ) $ }x ) + { + $station = $+{stop}; + $ts = $parser->parse_datetime( $+{timestamp} ); + if ($ts) { + my $epoch = $ts->epoch; + if ( $epoch < $prev_epoch ) { + return ( undef, +'Zeitstempel der Unterwegshalte müssen monoton steigend sein (keine Zeitreisen und keine Portale)' + ); + } + $station_data{sched_arr} = $epoch; + $station_data{sched_dep} = $epoch; + $prev_epoch = $epoch; + } + } my $station_info = $self->{stations} ->search( $station, backend_id => $opt{backend_id} ); if ($station_info) { + $station_data{lat} = $station_info->{lat}; + $station_data{lon} = $station_info->{lon}; push( @route, [ - $station_info->{name}, - $station_info->{eva}, - { - lat => $station_info->{lat}, - lon => $station_info->{lon}, - } + $station_info->{name}, $station_info->{eva}, + \%station_data, ] ); } @@ -283,8 +309,14 @@ sub add_from_in_transit { my $db = $opt{db}; my $journey = $opt{journey}; + if ( $journey->{train_id} eq 'manual' ) { + $journey->{edited} = 0x3fff; + } + else { + $journey->{edited} = 0; + } + delete $journey->{data}; - $journey->{edited} = 0; $journey->{checkout_time} = DateTime->now( time_zone => 'Europe/Berlin' ); return $db->insert( 'journeys', $journey, { returning => 'id' } ) @@ -301,16 +333,16 @@ sub update { my $rows; my $journey = $self->get_single( - uid => $uid, - db => $db, - journey_id => $journey_id, - with_datetime => 1, - with_route_datetime => 1, + uid => $uid, + db => $db, + journey_id => $journey_id, + with_datetime => 1, ); eval { if ( exists $opt{from_name} ) { - my $from_station = $self->{stations}->search( $opt{from_name} ); + my $from_station = $self->{stations} + ->search( $opt{from_name}, backend_id => $journey->{backend_id} ); if ( not $from_station ) { die("Unbekannter Startbahnhof\n"); } @@ -326,7 +358,8 @@ sub update { )->rows; } if ( exists $opt{to_name} ) { - my $to_station = $self->{stations}->search( $opt{to_name} ); + my $to_station = $self->{stations} + ->search( $opt{to_name}, backend_id => $journey->{backend_id} ); if ( not $to_station ) { die("Unbekannter Zielbahnhof\n"); } @@ -399,7 +432,40 @@ sub update { )->rows; } if ( exists $opt{route} ) { - my @new_route = map { [ $_, undef, {} ] } @{ $opt{route} }; + + # If $opt{route} is a subset of $journey->{route}, we can recycle all data + my @new_route; + my $new_route_i = 0; + for my $old_route_i ( 0 .. $#{ $journey->{route} } ) { + if ( $journey->{route}[$old_route_i][0] eq + $opt{route}[$new_route_i] ) + { + $new_route_i += 1; + push( @new_route, $journey->{route}[$old_route_i] ); + } + } + + # Otherwise, fetch stop IDs so that polylines remain usable + if ( @new_route != @{ $opt{route} } ) { + my %stop + = map { $_->{name} => $_ } $self->{stations}->get_by_names( + backend_id => $journey->{backend_id}, + names => [ $opt{route} ] + ); + @new_route = map { + [ + $_, + $stop{$_}{eva}, + defined $stop{$_}{eva} + ? { + lat => $stop{$_}{lat}, + lon => $stop{$_}{lon} + } + : {} + ] + } @{ $opt{route} }; + } + $rows = $db->update( 'journeys', { @@ -537,6 +603,83 @@ sub pop { return $journey; } +sub set_polyline { + my ( $self, %opt ) = @_; + + my $uid = $opt{uid}; + my $db = $opt{db} // $self->{pg}->db; + my $polyline = $opt{polyline}; + + my $from_eva = $opt{from_eva}; + my $to_eva = $opt{to_eva}; + + my $polyline_str = JSON->new->encode($polyline); + + my $pl_res = $db->select( + 'polylines', + ['id'], + { + origin_eva => $from_eva, + destination_eva => $to_eva, + polyline => $polyline_str, + }, + { limit => 1 } + ); + + my $polyline_id; + if ( my $h = $pl_res->hash ) { + $polyline_id = $h->{id}; + } + else { + $polyline_id = $db->insert( + 'polylines', + { + origin_eva => $from_eva, + destination_eva => $to_eva, + polyline => $polyline_str + }, + { returning => 'id' } + )->hash->{id}; + } + if ($polyline_id) { + $self->set_polyline_id( + uid => $uid, + db => $db, + polyline_id => $polyline_id, + journey_id => $opt{journey_id}, + edited => $opt{edited}, + ); + $self->stats_cache->invalidate( + ts => epoch_to_dt( $opt{stats_ts} ), + db => $db, + uid => $uid + ); + } + +} + +sub set_polyline_id { + my ( $self, %opt ) = @_; + + my $uid = $opt{uid}; + my $db = $opt{db} // $self->{pg}->db; + my $polyline_id = $opt{polyline_id}; + my $journey_id = $opt{journey_id}; + my $edited = $opt{edited}; + + $db->update( + 'journeys', + { + polyline_id => $polyline_id, + edited => $edited | 0x0040 + }, + { + user_id => $uid, + id => $opt{journey_id} + } + ); +} + sub get { my ( $self, %opt ) = @_; @@ -549,7 +692,7 @@ sub get { my @select = ( - qw(journey_id is_dbris is_iris is_hafas is_motis backend_name backend_id train_type train_line train_no checkin_ts sched_dep_ts real_dep_ts dep_eva dep_ds100 dep_name dep_lat dep_lon checkout_ts sched_arr_ts real_arr_ts arr_eva arr_ds100 arr_name arr_lat arr_lon cancelled edited route messages user_data visibility effective_visibility) + qw(journey_id is_dbris is_iris is_hafas is_motis backend_name backend_id train_type train_line train_no checkin_ts sched_dep_ts real_dep_ts dep_eva dep_ds100 dep_name dep_platform dep_lat dep_lon checkout_ts sched_arr_ts real_arr_ts arr_eva arr_ds100 arr_name arr_platform arr_lat arr_lon cancelled edited route messages user_data visibility effective_visibility) ); my %where = ( user_id => $uid, @@ -613,12 +756,13 @@ sub get { is_motis => $entry->{is_motis}, backend_name => $entry->{backend_name}, backend_id => $entry->{backend_id}, - type => $entry->{train_type}, + type => $entry->{train_type} =~ s{ \s+ $ }{}rx, line => $entry->{train_line}, no => $entry->{train_no}, from_eva => $entry->{dep_eva}, from_ds100 => $entry->{dep_ds100}, from_name => $entry->{dep_name}, + from_platform => $entry->{dep_platform}, from_latlon => [ $entry->{dep_lat}, $entry->{dep_lon} ], checkin_ts => $entry->{checkin_ts}, sched_dep_ts => $entry->{sched_dep_ts}, @@ -626,6 +770,7 @@ sub get { to_eva => $entry->{arr_eva}, to_ds100 => $entry->{arr_ds100}, to_name => $entry->{arr_name}, + to_platform => $entry->{arr_platform}, to_latlon => [ $entry->{arr_lat}, $entry->{arr_lon} ], checkout_ts => $entry->{checkout_ts}, sched_arr_ts => $entry->{sched_arr_ts}, @@ -659,12 +804,18 @@ sub get { $ref->{checkout} = epoch_to_dt( $ref->{checkout_ts} ); $ref->{sched_arrival} = epoch_to_dt( $ref->{sched_arr_ts} ); $ref->{rt_arrival} = epoch_to_dt( $ref->{rt_arr_ts} ); + if ( $ref->{rt_dep_ts} and $ref->{sched_dep_ts} ) { + $ref->{delay_dep} = $ref->{rt_dep_ts} - $ref->{sched_dep_ts}; + } + if ( $ref->{rt_arr_ts} and $ref->{sched_arr_ts} ) { + $ref->{delay_arr} = $ref->{rt_arr_ts} - $ref->{sched_arr_ts}; + } } if ( $opt{with_route_datetime} ) { for my $stop ( @{ $ref->{route} } ) { for my $k (qw(rt_arr rt_dep sched_arr sched_dep)) { if ( $stop->[2]{$k} ) { - $stop->[2]{$k} = epoch_to_dt( $stop->[2]{$k} ); + $stop->[2]{"${k}_dt"} = epoch_to_dt( $stop->[2]{$k} ); } } } @@ -1023,6 +1174,8 @@ sub generate_missing_stats { my $stats_index = 0; + my %need_year; + for my $journey_index ( 0 .. $#journey_months ) { if ( $stats_index < @stats_months and $journey_months[$journey_index][0] @@ -1034,6 +1187,7 @@ sub generate_missing_stats { } else { my ( $year, $month ) = @{ $journey_months[$journey_index] }; + $need_year{$year} = 1; $self->get_stats( uid => $uid, db => $db, @@ -1043,6 +1197,14 @@ sub generate_missing_stats { ); } } + for my $year ( keys %need_year ) { + $self->get_stats( + uid => $uid, + db => $db, + year => $year, + write_only => 1 + ); + } } sub get_nav_months { @@ -1133,9 +1295,10 @@ sub sanity_check { . ' Stimmt das wirklich?'; } if ( $journey->{edited} & 0x0010 and not $lax ) { - my @unknown_stations - = $self->{stations} - ->grep_unknown( map { $_->[0] } @{ $journey->{route} } ); + my @unknown_stations = $self->{stations}->grep_unknown( + backend_id => $journey->{backend_id}, + names => [ map { $_->[0] } @{ $journey->{route} } ] + ); if (@unknown_stations) { return 'Unbekannte Station(en): ' . join( ', ', @unknown_stations ); } @@ -1150,9 +1313,11 @@ sub get_travel_distance { my $from = $journey->{from_name}; my $from_eva = $journey->{from_eva}; my $from_latlon = $journey->{from_latlon}; + my $from_ts = $journey->{sched_dep_ts} // $journey->{rt_dep_ts}; my $to = $journey->{to_name}; my $to_eva = $journey->{to_eva}; my $to_latlon = $journey->{to_latlon}; + my $to_ts = $journey->{sched_arr_ts} // $journey->{rt_arr_ts}; my $route_ref = $journey->{route}; my $polyline_ref = $journey->{polyline}; @@ -1206,31 +1371,85 @@ sub get_travel_distance { my $geo = GIS::Distance->new(); my $distance_beeline = $geo->distance_metal( @{$from_latlon}, @{$to_latlon} ); - my @route - = after_incl { ( $_->[1] and $_->[1] == $from_eva ) or $_->[0] eq $from } + + # A trip may pass the same stop multiple times. + # Thus, two criteria must be met to select the start/end of the actual route: + # * stop name or ID matches, and + # * one of: + # - arrival/departure time at the stop matches, or + # - the stop does not have arrival/departure time + # In the latter case, we still face the risk of selecting the wrong + # start/end stop. However, we have no way of finding the right one. As the + # majority of trips do not pass the same stop multiple times, it's better + # to risk having a few inaccurate distances than not calculating the + # distance for any journey that lacks sched_dep/rt_dep or + # sched_from/rt_from. + + my $route_start = first_index { + ( + ( $_->[1] and $_->[1] == $from_eva or $_->[0] eq $from ) + and ( not( defined $_->[2]{sched_dep} or defined $_->[2]{rt_dep} ) + or ( $_->[2]{sched_dep} // $_->[2]{rt_dep} ) == $from_ts ) + ) + } @{$route_ref}; - @route - = before_incl { ( $_->[1] and $_->[1] == $to_eva ) or $_->[0] eq $to } - @route; - if ( - @route < 2 - or ( $route[-1][0] ne $to - and ( not $route[-1][1] or $route[-1][1] != $to_eva ) ) - ) - { + # Here, we need to use last_index. In case of ring lines, the first index + # will not have sched_arr/rt_arr set, but we should not select it as route + # end... + my $route_end = last_index { + ( + ( $_->[1] and $_->[1] == $to_eva or $_->[0] eq $to ) + and ( not( defined $_->[2]{sched_arr} or defined $_->[2]{rt_arr} ) + or ( $_->[2]{sched_arr} // $_->[2]{rt_arr} ) == $to_ts ) + ) + } + @{$route_ref}; - # I AM ERROR + if ( not defined $route_start and defined $route_end ) { return ( 0, 0, $distance_beeline ); } - my @polyline = after_incl { $_->[2] and $_->[2] == $from_eva } + my %seen; + for my $stop ( @{$route_ref} ) { + if ( not defined $stop->[1] ) { + return ( 0, 0, $distance_beeline ); + } + $seen{ $stop->[1] } //= 1; + $stop->[2]{n} = $seen{ $stop->[1] }; + $seen{ $stop->[1] } += 1; + } + + # Assumption: polyline entries are always [lat, lon] or [lat, lon, stop ID] + %seen = (); + for my $entry ( @{ $polyline_ref // [] } ) { + if ( $entry->[2] ) { + $seen{ $entry->[2] } //= 1; + $entry->[3] = $seen{ $entry->[2] }; + $seen{ $entry->[2] } += 1; + } + } + + $journey->{route_dep_index} = $route_start; + $journey->{route_arr_index} = $route_end; + + my @route = @{$route_ref}[ $route_start .. $route_end ]; + + # Just like the route, the polyline may contain the same stop more than + # once. So we need to select based on the seen counter. + my $poly_start = first_index { + $_->[2] and $_->[2] == $from_eva and $_->[3] == $route[0][2]{n} + } + @{ $polyline_ref // [] }; + my $poly_end = first_index { + $_->[2] and $_->[2] == $to_eva and $_->[3] == $route[-1][2]{n} + } @{ $polyline_ref // [] }; - @polyline - = before_incl { $_->[2] and $_->[2] == $to_eva } @polyline; - # ensure that before_incl matched -- otherwise, @polyline is too long - if ( @polyline and $polyline[-1][2] == $to_eva ) { + if ( defined $poly_start and defined $poly_end ) { + $journey->{poly_dep_index} = $poly_start; + $journey->{poly_arr_index} = $poly_end; + my @polyline = @{$polyline_ref}[ $poly_start .. $poly_end ]; my $prev_station = shift @polyline; for my $station (@polyline) { $distance_polyline += $geo->distance_metal( @@ -1850,6 +2069,34 @@ sub get_latest_dest_ids { ); } +sub get_frequent_backend_ids { + my ( $self, %opt ) = @_; + + my $uid = $opt{uid}; + my $threshold = $opt{threshold} + // DateTime->now( time_zone => 'Europe/Berlin' )->subtract( months => 4 ); + my $limit = $opt{limit} // 5; + my $db = $opt{db} //= $self->{pg}->db; + + my $res = $db->select( + 'journeys', + 'count(*) as count, backend_id', + { + user_id => $uid, + real_departure => { '>', $threshold }, + }, + { + group_by => ['backend_id'], + order_by => { -desc => 'count' }, + limit => $limit, + } + ); + + my @backend_ids = $res->hashes->map( sub { shift->{backend_id} } )->each; + + return @backend_ids; +} + # Returns a listref of {eva, name} hashrefs for the specified backend. sub get_connection_targets { my ( $self, %opt ) = @_; @@ -1857,9 +2104,14 @@ sub get_connection_targets { my $uid = $opt{uid}; my $threshold = $opt{threshold} // DateTime->now( time_zone => 'Europe/Berlin' )->subtract( months => 4 ); - my $db = $opt{db} //= $self->{pg}->db; - my $min_count = $opt{min_count} // 3; - my $dest_id = $opt{eva}; + my $db = $opt{db} //= $self->{pg}->db; + my $min_count = $opt{min_count} // 3; + my $backend_id = $opt{backend_id}; + my $dest_id = $opt{eva}; + + $self->{log}->debug( +"get_connection_targets(uid => $uid, backend_id => $backend_id, dest_id => $dest_id)" + ); if ( $opt{destination_name} ) { return { @@ -1868,8 +2120,6 @@ sub get_connection_targets { }; } - my $backend_id = $opt{backend_id}; - if ( not $dest_id ) { ( $dest_id, $backend_id ) = $self->get_latest_dest_ids(%opt); } @@ -1900,10 +2150,15 @@ sub get_connection_targets { order_by => { -desc => 'count' } } ); - my @destinations - = $res->hashes->grep( sub { shift->{count} >= $min_count } ) - ->map( sub { shift->{dest} } ) - ->each; + my @all_destinations = $res->hashes->each; + my @destinations; + + while ( not @destinations and $min_count > 0 ) { + @destinations = map { $_->{dest} } + grep { $_->{count} >= $min_count } @all_destinations; + $min_count--; + } + @destinations = $self->{stations}->get_by_evas( backend_id => $opt{backend_id}, evas => [@destinations] |