diff options
Diffstat (limited to 'lib/Travelynx/Model/Journeys.pm')
| -rwxr-xr-x | lib/Travelynx/Model/Journeys.pm | 1104 |
1 files changed, 944 insertions, 160 deletions
diff --git a/lib/Travelynx/Model/Journeys.pm b/lib/Travelynx/Model/Journeys.pm index a0981c6..b07511a 100755 --- a/lib/Travelynx/Model/Journeys.pm +++ b/lib/Travelynx/Model/Journeys.pm @@ -1,20 +1,35 @@ package Travelynx::Model::Journeys; -# Copyright (C) 2020 Daniel Friesel +# Copyright (C) 2020-2023 Birte Kristina Friesel # # SPDX-License-Identifier: AGPL-3.0-or-later -use Geo::Distance; -use List::MoreUtils qw(after_incl before_incl); -use Travel::Status::DE::IRIS::Stations; - 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); + +my %visibility_itoa = ( + 100 => 'public', + 80 => 'travelynx', + 60 => 'followers', + 30 => 'unlisted', + 10 => 'private', +); + +my %visibility_atoi = ( + public => 100, + travelynx => 80, + followers => 60, + unlisted => 30, + private => 10, +); my @month_name = ( @@ -35,54 +50,57 @@ sub epoch_to_dt { ); } -sub get_station { - my ( $station_name, $exact_match ) = @_; +sub min_to_human { + my ( $self, $minutes ) = @_; - my @candidates - = Travel::Status::DE::IRIS::Stations::get_station($station_name); + my @ret; - if ( @candidates == 1 ) { - if ( not $exact_match ) { - return $candidates[0]; - } - if ( $candidates[0][0] eq $station_name - or $candidates[0][1] eq $station_name - or $candidates[0][2] eq $station_name ) - { - return $candidates[0]; - } - return undef; + if ( $minutes >= 14 * 24 * 60 ) { + push( @ret, int( $minutes / ( 7 * 24 * 60 ) ) . ' Wochen' ); } - return undef; -} + elsif ( $minutes >= 7 * 24 * 60 ) { + push( @ret, '1 Woche' ); + } + $minutes %= 7 * 24 * 60; -sub grep_unknown_stations { - my (@stations) = @_; + if ( $minutes >= 2 * 24 * 60 ) { + push( @ret, int( $minutes / ( 24 * 60 ) ) . ' Tage' ); + } + elsif ( $minutes >= 24 * 60 ) { + push( @ret, '1 Tag' ); + } + $minutes %= 24 * 60; - my @unknown_stations; - for my $station (@stations) { - my $station_info = get_station($station); - if ( not $station_info ) { - push( @unknown_stations, $station ); - } + if ( $minutes >= 2 * 60 ) { + push( @ret, int( $minutes / 60 ) . ' Stunden' ); + } + elsif ( $minutes >= 60 ) { + push( @ret, '1 Stunde' ); + } + $minutes %= 60; + + if ( $minutes >= 2 ) { + push( @ret, "$minutes Minuten" ); + } + elsif ($minutes) { + push( @ret, '1 Minute' ); } - return @unknown_stations; + + if ( @ret == 0 ) { + return '0 Minuten'; + } + + if ( @ret == 1 ) { + return $ret[0]; + } + + my $last = pop(@ret); + return join( ', ', @ret ) . " und $last"; } sub new { my ( $class, %opt ) = @_; - $opt{journey_edit_mask} = { - sched_departure => 0x0001, - real_departure => 0x0002, - from_station => 0x0004, - route => 0x0010, - is_cancelled => 0x0020, - sched_arrival => 0x0100, - real_arrival => 0x0200, - to_station => 0x0400, - }; - return bless( \%opt, $class ); } @@ -100,8 +118,10 @@ sub add { my $db = $opt{db}; my $uid = $opt{uid}; my $now = DateTime->now( time_zone => 'Europe/Berlin' ); - my $dep_station = get_station( $opt{dep_station} ); - my $arr_station = get_station( $opt{arr_station} ); + my $dep_station = $self->{stations} + ->search( $opt{dep_station}, backend_id => $opt{backend_id} ); + my $arr_station = $self->{stations} + ->search( $opt{arr_station}, backend_id => $opt{backend_id} ); if ( not $dep_station ) { return ( undef, 'Unbekannter Startbahnhof' ); @@ -134,10 +154,14 @@ sub add { my $route_has_stop = 0; for my $station ( @{ $opt{route} || [] } ) { - if ( $station eq $dep_station->[1] or $station eq $dep_station->[0] ) { + if ( $station eq $dep_station->{name} + or $station eq $dep_station->{ds100} ) + { $route_has_start = 1; } - if ( $station eq $arr_station->[1] or $station eq $arr_station->[0] ) { + if ( $station eq $arr_station->{name} + or $station eq $arr_station->{ds100} ) + { $route_has_stop = 1; } } @@ -145,18 +169,63 @@ sub add { my @route; if ( not $route_has_start ) { - push( @route, [ $dep_station->[1], {}, undef ] ); + push( + @route, + [ + $dep_station->{name}, + $dep_station->{eva}, + { + lat => $dep_station->{lat}, + lon => $dep_station->{lon}, + } + ] + ); } 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 $station_info = get_station($station); + 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) { - push( @route, [ $station_info->[1], {}, undef ] ); + $station_data{lat} = $station_info->{lat}; + $station_data{lon} = $station_info->{lon}; + push( + @route, + [ + $station_info->{name}, $station_info->{eva}, + \%station_data, + ] + ); } else { - push( @route, [ $station, {}, undef ] ); + push( @route, [ $station, undef, {} ] ); push( @unknown_stations, $station ); } } @@ -175,7 +244,17 @@ sub add { } if ( not $route_has_stop ) { - push( @route, [ $arr_station->[1], {}, undef ] ); + push( + @route, + [ + $arr_station->{name}, + $arr_station->{eva}, + { + lat => $arr_station->{lat}, + lon => $arr_station->{lon}, + } + ] + ); } my $entry = { @@ -184,17 +263,18 @@ sub add { train_line => $opt{train_line}, train_no => $opt{train_no}, train_id => 'manual', - checkin_station_id => $dep_station->[2], + checkin_station_id => $dep_station->{eva}, checkin_time => $now, sched_departure => $opt{sched_departure}, real_departure => $opt{rt_departure}, - checkout_station_id => $arr_station->[2], + checkout_station_id => $arr_station->{eva}, sched_arrival => $opt{sched_arrival}, real_arrival => $opt{rt_arrival}, checkout_time => $now, edited => 0x3fff, cancelled => $opt{cancelled} ? 1 : 0, route => JSON->new->encode( \@route ), + backend_id => $opt{backend_id}, }; if ( $opt{comment} ) { @@ -227,11 +307,18 @@ 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' ); - $db->insert( 'journeys', $journey ); + return $db->insert( 'journeys', $journey, { returning => 'id' } ) + ->hash->{id}; } sub update { @@ -244,22 +331,23 @@ sub update { my $rows; my $journey = $self->get_single( - uid => $uid, - db => $db, - journey_id => $journey_id, - with_datetime => 1, + uid => $uid, + db => $db, + journey_id => $journey_id, + with_datetime => 1, + with_route_datetime => 1, ); eval { if ( exists $opt{from_name} ) { - my $from_station = get_station( $opt{from_name}, 1 ); + my $from_station = $self->{stations}->search( $opt{from_name} ); if ( not $from_station ) { die("Unbekannter Startbahnhof\n"); } $rows = $db->update( 'journeys', { - checkin_station_id => $from_station->[2], + checkin_station_id => $from_station->{eva}, edited => $journey->{edited} | 0x0004, }, { @@ -268,14 +356,14 @@ sub update { )->rows; } if ( exists $opt{to_name} ) { - my $to_station = get_station( $opt{to_name}, 1 ); + my $to_station = $self->{stations}->search( $opt{to_name} ); if ( not $to_station ) { die("Unbekannter Zielbahnhof\n"); } $rows = $db->update( 'journeys', { - checkout_station_id => $to_station->[2], + checkout_station_id => $to_station->{eva}, edited => $journey->{edited} | 0x0400, }, { @@ -341,7 +429,7 @@ sub update { )->rows; } if ( exists $opt{route} ) { - my @new_route = map { [ $_, {}, undef ] } @{ $opt{route} }; + my @new_route = map { [ $_, undef, {} ] } @{ $opt{route} }; $rows = $db->update( 'journeys', { @@ -491,7 +579,7 @@ sub get { my @select = ( - qw(journey_id train_type train_line train_no checkin_ts sched_dep_ts real_dep_ts dep_eva checkout_ts sched_arr_ts real_arr_ts arr_eva cancelled edited route messages user_data) + 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, @@ -511,6 +599,10 @@ sub get { $order{limit} = $opt{limit}; } + if ( $opt{sched_dep_ts} ) { + $where{sched_dep_ts} = $opt{sched_dep_ts}; + } + if ( $opt{journey_id} ) { $where{journey_id} = $opt{journey_id}; delete $where{cancelled}; @@ -519,11 +611,24 @@ sub get { $where{real_dep_ts} = { -between => [ $opt{after}->epoch, $opt{before}->epoch, ] }; } + elsif ( $opt{after} ) { + $where{real_dep_ts} = { '>=', $opt{after}->epoch }; + } + elsif ( $opt{before} ) { + $where{real_dep_ts} = { '<=', $opt{before}->epoch }; + } if ( $opt{with_polyline} ) { push( @select, 'polyline' ); } + if ( $opt{min_visibility} ) { + if ( $visibility_atoi{ $opt{min_visibility} } ) { + $opt{min_visibility} = $visibility_atoi{ $opt{min_visibility} }; + } + $where{effective_visibility} = { '>=', $opt{min_visibility} }; + } + my @travels; my $res = $db->select( 'journeys_str', \@select, \%where, \%order ); @@ -531,35 +636,51 @@ sub get { for my $entry ( $res->expand->hashes->each ) { my $ref = { - id => $entry->{journey_id}, - type => $entry->{train_type}, - line => $entry->{train_line}, - no => $entry->{train_no}, - from_eva => $entry->{dep_eva}, - checkin_ts => $entry->{checkin_ts}, - sched_dep_ts => $entry->{sched_dep_ts}, - rt_dep_ts => $entry->{real_dep_ts}, - to_eva => $entry->{arr_eva}, - checkout_ts => $entry->{checkout_ts}, - sched_arr_ts => $entry->{sched_arr_ts}, - rt_arr_ts => $entry->{real_arr_ts}, - messages => $entry->{messages}, - route => $entry->{route}, - edited => $entry->{edited}, - user_data => $entry->{user_data}, + id => $entry->{journey_id}, + is_dbris => $entry->{is_dbris}, + is_iris => $entry->{is_iris}, + is_hafas => $entry->{is_hafas}, + is_motis => $entry->{is_motis}, + backend_name => $entry->{backend_name}, + backend_id => $entry->{backend_id}, + 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}, + rt_dep_ts => $entry->{real_dep_ts}, + 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}, + rt_arr_ts => $entry->{real_arr_ts}, + messages => $entry->{messages}, + route => $entry->{route}, + edited => $entry->{edited}, + user_data => $entry->{user_data}, + visibility => $entry->{visibility}, + effective_visibility => $entry->{effective_visibility}, }; - if ( $opt{with_polyline} ) { - $ref->{polyline} = $entry->{polyline}; + if ( $opt{with_visibility} ) { + $ref->{visibility_str} + = $ref->{visibility} + ? $visibility_itoa{ $ref->{visibility} } + : 'default'; + $ref->{effective_visibility_str} + = $visibility_itoa{ $ref->{effective_visibility} }; } - if ( my $station = $self->{station_by_eva}->{ $ref->{from_eva} } ) { - $ref->{from_ds100} = $station->[0]; - $ref->{from_name} = $station->[1]; - } - if ( my $station = $self->{station_by_eva}->{ $ref->{to_eva} } ) { - $ref->{to_ds100} = $station->[0]; - $ref->{to_name} = $station->[1]; + if ( $opt{with_polyline} ) { + $ref->{polyline} = $entry->{polyline}; } if ( $opt{with_datetime} ) { @@ -570,11 +691,34 @@ 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} ); + } + } + } } if ( $opt{verbose} ) { my $rename = $self->{renamed_station}; for my $stop ( @{ $ref->{route} } ) { + if ( $stop->[0] =~ m{^Betriebsstelle nicht bekannt (\d+)$} ) { + if ( my $s + = $self->{stations} + ->get_by_eva( $1, backend_id => $ref->{backend_id} ) ) + { + $stop->[0] = $s->{name}; + } + } if ( $rename->{ $stop->[0] } ) { $stop->[0] = $rename->{ $stop->[0] }; } @@ -643,11 +787,20 @@ sub get_latest { cancelled => 0 }, { - order_by => { -desc => 'journey_id' }, + order_by => { -desc => 'real_dep_ts' }, limit => 1 } )->expand->hash; + if ($latest_successful) { + $latest_successful->{visibility_str} + = $latest_successful->{visibility} + ? $visibility_itoa{ $latest_successful->{visibility} } + : 'default'; + $latest_successful->{effective_visibility_str} + = $visibility_itoa{ $latest_successful->{effective_visibility} }; + } + my $latest = $db->select( 'journeys_str', '*', @@ -660,6 +813,15 @@ sub get_latest { } )->expand->hash; + if ($latest) { + $latest->{visibility_str} + = $latest->{visibility} + ? $visibility_itoa{ $latest->{visibility} } + : 'default'; + $latest->{effective_visibility_str} + = $visibility_itoa{ $latest->{effective_visibility} }; + } + return ( $latest_successful, $latest ); } @@ -688,14 +850,40 @@ sub get_oldest_ts { return undef; } -sub get_latest_checkout_station_id { +sub get_latest_checkout_latlon { + my ( $self, %opt ) = @_; + my $uid = $opt{uid}; + my $db = $opt{db} // $self->{pg}->db; + + my $res_h = $db->select( + 'journeys_str', + [ 'arr_lat', 'arr_lon', ], + { + user_id => $uid, + cancelled => 0 + }, + { + limit => 1, + order_by => { -desc => 'journey_id' } + } + )->hash; + + if ( not $res_h ) { + return; + } + + return $res_h->{arr_lat}, $res_h->{arr_lon}; + +} + +sub get_latest_checkout_ids { my ( $self, %opt ) = @_; my $uid = $opt{uid}; my $db = $opt{db} // $self->{pg}->db; my $res_h = $db->select( 'journeys', - ['checkout_station_id'], + [ 'checkout_station_id', 'backend_id', ], { user_id => $uid, cancelled => 0 @@ -710,7 +898,58 @@ sub get_latest_checkout_station_id { return; } - return $res_h->{checkout_station_id}; + return $res_h->{checkout_station_id}, $res_h->{backend_id}; +} + +sub get_latest_checkout_stations { + my ( $self, %opt ) = @_; + my $uid = $opt{uid}; + my $db = $opt{db} // $self->{pg}->db; + my $limit = $opt{limit} // 5; + + my $res = $db->select( + 'journeys_str', + [ + 'arr_name', 'arr_eva', + 'arr_external_id', 'train_id', + 'backend_id', 'backend_name', + 'is_dbris', 'is_efa', + 'is_hafas', 'is_motis' + ], + { + user_id => $uid, + cancelled => 0 + }, + { + limit => $limit, + order_by => { -desc => 'journey_id' } + } + ); + + if ( not $res ) { + return; + } + + my @ret; + + while ( my $row = $res->hash ) { + push( + @ret, + { + name => $row->{arr_name}, + eva => $row->{arr_eva}, + external_id_or_eva => $row->{arr_external_id} + // $row->{arr_eva}, + dbris => $row->{is_dbris} ? $row->{backend_name} : 0, + efa => $row->{is_efa} ? $row->{backend_name} : 0, + hafas => $row->{is_hafas} ? $row->{backend_name} : 0, + motis => $row->{is_motis} ? $row->{backend_name} : 0, + backend_id => $row->{backend_id}, + } + ); + } + + return @ret; } sub get_nav_years { @@ -903,36 +1142,38 @@ sub sanity_check { if ( defined $journey->{sched_duration} and $journey->{sched_duration} <= 0 ) { - return -'Die geplante Dauer dieser Zugfahrt ist ≤ 0. Teleportation und Zeitreisen werden aktuell nicht unterstützt.'; + return 'Die geplante Dauer dieser Fahrt ist ≤ 0.' + . ' Teleportation und Zeitreisen werden in diesem Universum nicht unterstützt.'; } if ( defined $journey->{rt_duration} and $journey->{rt_duration} <= 0 ) { - return -'Die Dauer dieser Zugfahrt ist ≤ 0. Teleportation und Zeitreisen werden aktuell nicht unterstützt.'; + return 'Die Dauer dieser Fahrt ist ≤ 0.' + . ' Teleportation und Zeitreisen werden in diesem Universum nicht unterstützt.'; } if ( $journey->{sched_duration} - and $journey->{sched_duration} > 60 * 60 * 24 ) + and $journey->{sched_duration} > 60 * 60 * 72 ) { - return 'Die Zugfahrt ist länger als 24 Stunden.'; + return 'Die Fahrt ist länger als drei Tage.'; } if ( $journey->{rt_duration} - and $journey->{rt_duration} > 60 * 60 * 24 ) + and $journey->{rt_duration} > 60 * 60 * 72 ) { - return 'Die Zugfahrt ist länger als 24 Stunden.'; + return 'Die Fahrt ist länger als drei Tage.'; } if ( $journey->{kmh_route} > 500 or $journey->{kmh_beeline} > 500 ) { - return 'Zugfahrten mit über 500 km/h? Schön wär\'s.'; + return 'Die berechnete Geschwindigkeit beträgt über 500 km/h.' + . ' Das wirkt unrealistisch.'; } - if ( $journey->{route} and @{ $journey->{route} } > 99 ) { + if ( $journey->{route} and @{ $journey->{route} } > 199 ) { my $stop_count = @{ $journey->{route} }; - return -"Die Zugfahrt hat $stop_count Unterwegshalte. Also ich weiß ja nicht so recht."; + return "Die Fahrt hat $stop_count Unterwegshalte. " + . ' Stimmt das wirklich?'; } if ( $journey->{edited} & 0x0010 and not $lax ) { my @unknown_stations - = grep_unknown_stations( map { $_->[0] } @{ $journey->{route} } ); + = $self->{stations} + ->grep_unknown( map { $_->[0] } @{ $journey->{route} } ); if (@unknown_stations) { return 'Unbekannte Station(en): ' . join( ', ', @unknown_stations ); } @@ -946,24 +1187,79 @@ sub get_travel_distance { my $from = $journey->{from_name}; my $from_eva = $journey->{from_eva}; + my $from_latlon = $journey->{from_latlon}; my $to = $journey->{to_name}; my $to_eva = $journey->{to_eva}; + my $to_latlon = $journey->{to_latlon}; my $route_ref = $journey->{route}; my $polyline_ref = $journey->{polyline}; + if ( not $to ) { + $self->{log} + ->warn("Journey $journey->{id} has no to_name for EVA $to_eva"); + } + + if ( not $from ) { + $self->{log} + ->warn("Journey $journey->{id} has no from_name for EVA $from_eva"); + } + + # Work around inconsistencies caused by a multiple EVA IDs mapping to the same station name + if ( + @{ $polyline_ref // [] } + and not List::MoreUtils::any { $_->[2] and $_->[2] == $from_eva } + @{ $polyline_ref // [] } + ) + { + $self->{log}->debug( +"Journey $journey->{id} from_eva ($from_eva) is not part of polyline" + ); + for my $entry ( @{$route_ref} ) { + if ( $entry->[0] eq $from and $entry->[1] ) { + $from_eva = $entry->[1]; + $self->{log}->debug("... setting to $from_eva"); + last; + } + } + } + if ( + @{ $polyline_ref // [] } + and not List::MoreUtils::any { $_->[2] and $_->[2] == $to_eva } + @{ $polyline_ref // [] } + ) + { + $self->{log}->debug( + "Journey $journey->{id} to_eva ($to_eva) is not part of polyline"); + for my $entry ( @{$route_ref} ) { + if ( $entry->[0] eq $to and $entry->[1] ) { + $to_eva = $entry->[1]; + $self->{log}->debug("... setting to $to_eva"); + last; + } + } + } + my $distance_polyline = 0; my $distance_intermediate = 0; - my $distance_beeline = 0; - my $skipped = 0; - my $geo = Geo::Distance->new(); - my @stations = map { $_->[0] } @{$route_ref}; - my @route = after_incl { $_ eq $from } @stations; - @route = before_incl { $_ eq $to } @route; + 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 } + @{$route_ref}; + @route + = before_incl { ( $_->[1] and $_->[1] == $to_eva ) or $_->[0] eq $to } + @route; - if ( @route < 2 ) { + if ( + @route < 2 + or ( $route[-1][0] ne $to + and ( not $route[-1][1] or $route[-1][1] != $to_eva ) ) + ) + { # I AM ERROR - return ( 0, 0, 0 ); + return ( 0, 0, $distance_beeline ); } my @polyline = after_incl { $_->[2] and $_->[2] == $from_eva } @@ -971,60 +1267,400 @@ sub get_travel_distance { @polyline = before_incl { $_->[2] and $_->[2] == $to_eva } @polyline; - my $prev_station = shift @polyline; - for my $station (@polyline) { + # ensure that before_incl matched -- otherwise, @polyline is too long + if ( @polyline and $polyline[-1][2] == $to_eva ) { + my $prev_station = shift @polyline; + for my $station (@polyline) { + $distance_polyline += $geo->distance_metal( + $prev_station->[1], $prev_station->[0], + $station->[1], $station->[0] + ); + $prev_station = $station; + } + } + + if ( defined $route[0][2]{lat} and defined $route[0][2]{lon} ) { + my $prev_station = shift @route; + for my $station (@route) { + if ( defined $station->[2]{lat} and defined $station->[2]{lon} ) { + $distance_intermediate += $geo->distance_metal( + $prev_station->[2]{lat}, $prev_station->[2]{lon}, + $station->[2]{lat}, $station->[2]{lon} + ); + $prev_station = $station; + } + } + } + + return ( $distance_polyline, $distance_intermediate, $distance_beeline ); +} - #lonlatlonlat - $distance_polyline - += $geo->distance( 'kilometer', $prev_station->[0], - $prev_station->[1], $station->[0], $station->[1] ); - $prev_station = $station; +sub grep_single { + my ( $self, @journeys ) = @_; + + my %num_by_trip; + for my $journey (@journeys) { + if ( $journey->{from_name} and $journey->{to_name} ) { + $num_by_trip{ $journey->{from_name} . '|' . $journey->{to_name} } + += 1; + } } - $prev_station = get_station( shift @route ); - if ( not $prev_station ) { - return ( $distance_polyline, 0, 0 ); + return + grep { $num_by_trip{ $_->{from_name} . '|' . $_->{to_name} } == 1 } + @journeys; +} + +sub compute_review { + my ( $self, $stats, @journeys ) = @_; + my $longest_km; + my $longest_t; + my $shortest_km; + my $shortest_t; + my $most_delayed; + my $most_delay; + my $most_undelay; + my $num_cancelled = 0; + my $num_fgr = 0; + my $num_punctual = 0; + my $message_count = 0; + my %num_by_message; + my %num_by_wrtype; + my %num_by_linetype; + my %num_by_stop; + my %num_by_trip; + + if ( not $stats or not @journeys or $stats->{num_trains} == 0 ) { + return; } - # Geo-coordinates for stations outside Germany are not available - # at the moment. When calculating distance with intermediate stops, - # these are simply left out (as if they were not part of the route). - # For beeline distance calculation, we use the route's first and last - # station with known geo-coordinates. - my $from_station_beeline; - my $to_station_beeline; + my %review; - # $#{$station} >= 4 iff $station has geocoordinates - for my $station_name (@route) { - if ( my $station = get_station($station_name) ) { - if ( not $from_station_beeline and $#{$prev_station} >= 4 ) { - $from_station_beeline = $prev_station; + for my $journey (@journeys) { + if ( $journey->{cancelled} ) { + $num_cancelled += 1; + next; + } + + my %seen; + + if ( $journey->{rt_duration} and $journey->{rt_duration} > 0 ) { + if ( not $longest_t + or $journey->{rt_duration} > $longest_t->{rt_duration} ) + { + $longest_t = $journey; } - if ( $#{$station} >= 4 ) { - $to_station_beeline = $station; + if ( not $shortest_t + or $journey->{rt_duration} < $shortest_t->{rt_duration} ) + { + $shortest_t = $journey; } - if ( $#{$prev_station} >= 4 and $#{$station} >= 4 ) { - $distance_intermediate - += $geo->distance( 'kilometer', $prev_station->[3], - $prev_station->[4], $station->[3], $station->[4] ); + } + + if ( $journey->{km_route} ) { + if ( not $longest_km + or $journey->{km_route} > $longest_km->{km_route} ) + { + $longest_km = $journey; } - else { - $skipped++; + if ( not $shortest_km + or $journey->{km_route} < $shortest_km->{km_route} ) + { + $shortest_km = $journey; + } + } + + if ( $journey->{messages} and @{ $journey->{messages} } ) { + $message_count += 1; + for my $message ( @{ $journey->{messages} } ) { + if ( not $seen{ $message->[1] } ) { + $num_by_message{ $message->[1] } += 1; + $seen{ $message->[1] } = 1; + } + } + } + + if ( $journey->{type} ) { + $num_by_linetype{ $journey->{type} } += 1; + } + + if ( $journey->{from_name} ) { + $num_by_stop{ $journey->{from_name} } += 1; + } + if ( $journey->{to_name} ) { + $num_by_stop{ $journey->{to_name} } += 1; + } + if ( $journey->{from_name} and $journey->{to_name} ) { + $num_by_trip{ $journey->{from_name} . '|' . $journey->{to_name} } + += 1; + } + + if ( $journey->{sched_dep_ts} and $journey->{rt_dep_ts} ) { + $journey->{delay_dep} + = ( $journey->{rt_dep_ts} - $journey->{sched_dep_ts} ) / 60; + } + if ( $journey->{sched_arr_ts} and $journey->{rt_arr_ts} ) { + $journey->{delay_arr} + = ( $journey->{rt_arr_ts} - $journey->{sched_arr_ts} ) / 60; + } + + if ( $journey->{delay_arr} and $journey->{delay_arr} >= 60 ) { + $num_fgr += 1; + } + if ( not $journey->{delay_arr} and not $journey->{delay_dep} ) { + $num_punctual += 1; + } + + if ( $journey->{delay_arr} and $journey->{delay_arr} > 0 ) { + if ( not $most_delayed + or $journey->{delay_arr} > $most_delayed->{delay_arr} ) + { + $most_delayed = $journey; + } + } + + if ( $journey->{rt_duration} + and $journey->{sched_duration} + and $journey->{rt_duration} > 0 + and $journey->{sched_duration} > 0 ) + { + my $slowdown = $journey->{rt_duration} - $journey->{sched_duration}; + my $speedup = -$slowdown; + if ( + not $most_delay + or $slowdown > ( + $most_delay->{rt_duration} - $most_delay->{sched_duration} + ) + ) + { + $most_delay = $journey; + } + if ( + not $most_undelay + or $speedup > ( + $most_undelay->{sched_duration} + - $most_undelay->{rt_duration} + ) + ) + { + $most_undelay = $journey; } - $prev_station = $station; } } - if ( $from_station_beeline and $to_station_beeline ) { - $distance_beeline = $geo->distance( - 'kilometer', $from_station_beeline->[3], - $from_station_beeline->[4], $to_station_beeline->[3], - $to_station_beeline->[4] - ); + my @linetypes = sort { $b->[1] <=> $a->[1] } + map { [ $_, $num_by_linetype{$_} ] } keys %num_by_linetype; + my @stops = sort { $b->[1] <=> $a->[1] } + map { [ $_, $num_by_stop{$_} ] } keys %num_by_stop; + my @trips = sort { $b->[1] <=> $a->[1] } + map { [ $_, $num_by_trip{$_} ] } keys %num_by_trip; + + my @reasons = sort { $b->[1] <=> $a->[1] } + map { [ $_, $num_by_message{$_} ] } keys %num_by_message; + + $review{num_stops} = scalar @stops; + $review{km_circle} = $stats->{km_route} / 40030; + $review{km_diag} = $stats->{km_route} / 12742; + + $review{trains_per_day} = sprintf( '%.1f', $stats->{num_trains} / 365 ); + $review{km_route} = sprintf( '%.0f', $stats->{km_route} ); + $review{km_beeline} = sprintf( '%.0f', $stats->{km_beeline} ); + $review{km_circle_h} = sprintf( '%.1f', $review{km_circle} ); + $review{km_diag_h} = sprintf( '%.1f', $review{km_diag} ); + + $review{trains_per_day} =~ tr{.}{,}; + $review{km_circle_h} =~ tr{.}{,}; + $review{km_diag_h} =~ tr{.}{,}; + + my $min_total = $stats->{min_travel_real} + $stats->{min_interchange_real}; + $review{traveling_min_total} = $min_total; + $review{traveling_percentage_year} + = sprintf( "%.1f%%", $min_total * 100 / 525948.77 ); + $review{traveling_percentage_year} =~ tr{.}{,}; + $review{traveling_time_year} = $self->min_to_human($min_total); + + if (@linetypes) { + $review{typical_type_1} = $linetypes[0][0]; + } + if ( @linetypes > 1 ) { + $review{typical_type_2} = $linetypes[1][0]; + } + if ( @stops >= 3 ) { + my $desc = q{}; + $review{typical_stops_3} = [ $stops[0][0], $stops[1][0], $stops[2][0] ]; + } + elsif ( @stops == 2 ) { + $review{typical_stops_2} = [ $stops[0][0], $stops[1][0] ]; + } + $review{typical_time} + = $self->min_to_human( $stats->{min_travel_real} / $stats->{num_trains} ); + $review{typical_km} + = sprintf( '%.0f', $stats->{km_route} / $stats->{num_trains} ); + $review{typical_kmh} = sprintf( '%.0f', + $stats->{km_route} / ( $stats->{min_travel_real} / 60 ) ); + $review{typical_delay_dep} + = sprintf( '%.0f', $stats->{delay_dep} / $stats->{num_trains} ); + $review{typical_delay_dep_h} + = $self->min_to_human( $review{typical_delay_dep} ); + $review{typical_delay_arr} + = sprintf( '%.0f', $stats->{delay_arr} / $stats->{num_trains} ); + $review{typical_delay_arr_h} + = $self->min_to_human( $review{typical_delay_arr} ); + + if ($longest_t) { + $review{longest_t_time} + = $self->min_to_human( $longest_t->{rt_duration} / 60 ); + $review{longest_t_type} = $longest_t->{type}; + $review{longest_t_lineno} = $longest_t->{line} // $longest_t->{no}; + $review{longest_t_from} = $longest_t->{from_name}; + $review{longest_t_to} = $longest_t->{to_name}; + $review{longest_t_id} = $longest_t->{id}; + } + + if ($longest_km) { + $review{longest_km_km} = sprintf( '%.0f', $longest_km->{km_route} ); + $review{longest_km_type} = $longest_km->{type}; + $review{longest_km_lineno} = $longest_km->{line} // $longest_km->{no}; + $review{longest_km_from} = $longest_km->{from_name}; + $review{longest_km_to} = $longest_km->{to_name}; + $review{longest_km_id} = $longest_km->{id}; + } + + if ($shortest_t) { + $review{shortest_t_time} + = $self->min_to_human( $shortest_t->{rt_duration} / 60 ); + $review{shortest_t_type} = $shortest_t->{type}; + $review{shortest_t_lineno} = $shortest_t->{line} // $shortest_t->{no}; + $review{shortest_t_from} = $shortest_t->{from_name}; + $review{shortest_t_to} = $shortest_t->{to_name}; + $review{shortest_t_id} = $shortest_t->{id}; + } + + if ($shortest_km) { + $review{shortest_km_m} + = sprintf( '%.0f', $shortest_km->{km_route} * 1000 ); + $review{shortest_km_type} = $shortest_km->{type}; + $review{shortest_km_lineno} = $shortest_km->{line} + // $shortest_km->{no}; + $review{shortest_km_from} = $shortest_km->{from_name}; + $review{shortest_km_to} = $shortest_km->{to_name}; + $review{shortest_km_id} = $shortest_km->{id}; + } + + if ($most_delayed) { + $review{most_delayed_type} = $most_delayed->{type}; + $review{most_delayed_delay_dep} + = $self->min_to_human( $most_delayed->{delay_dep} ); + $review{most_delayed_delay_arr} + = $self->min_to_human( $most_delayed->{delay_arr} ); + $review{most_delayed_lineno} = $most_delayed->{line} + // $most_delayed->{no}; + $review{most_delayed_from} = $most_delayed->{from_name}; + $review{most_delayed_to} = $most_delayed->{to_name}; + $review{most_delayed_id} = $most_delayed->{id}; + } + + if ($most_delay) { + $review{most_delay_type} = $most_delay->{type}; + $review{most_delay_delay_dep} = $most_delay->{delay_dep}; + $review{most_delay_delay_arr} = $most_delay->{delay_arr}; + $review{most_delay_sched_time} + = $self->min_to_human( $most_delay->{sched_duration} / 60 ); + $review{most_delay_real_time} + = $self->min_to_human( $most_delay->{rt_duration} / 60 ); + $review{most_delay_delta} + = $self->min_to_human( + ( $most_delay->{rt_duration} - $most_delay->{sched_duration} ) + / 60 ); + $review{most_delay_lineno} = $most_delay->{line} // $most_delay->{no}; + $review{most_delay_from} = $most_delay->{from_name}; + $review{most_delay_to} = $most_delay->{to_name}; + $review{most_delay_id} = $most_delay->{id}; + } + + if ($most_undelay) { + $review{most_undelay_type} = $most_undelay->{type}; + $review{most_undelay_delay_dep} = $most_undelay->{delay_dep}; + $review{most_undelay_delay_arr} = $most_undelay->{delay_arr}; + $review{most_undelay_sched_time} + = $self->min_to_human( $most_undelay->{sched_duration} / 60 ); + $review{most_undelay_real_time} + = $self->min_to_human( $most_undelay->{rt_duration} / 60 ); + $review{most_undelay_delta} + = $self->min_to_human( + ( $most_undelay->{sched_duration} - $most_undelay->{rt_duration} ) + / 60 ); + $review{most_undelay_lineno} = $most_undelay->{line} + // $most_undelay->{no}; + $review{most_undelay_from} = $most_undelay->{from_name}; + $review{most_undelay_to} = $most_undelay->{to_name}; + $review{most_undelay_id} = $most_undelay->{id}; + } + + $review{issue_percent} + = sprintf( '%.0f%%', $message_count * 100 / $stats->{num_trains} ); + for my $i ( 0 .. 2 ) { + if ( $reasons[$i] ) { + my $p = 'issue' . ( $i + 1 ); + $review{"${p}_count"} = $reasons[$i][1]; + $review{"${p}_text"} = $reasons[$i][0]; + } + } + + $review{cancel_count} = $num_cancelled; + $review{fgr_percent} = $num_fgr * 100 / $stats->{num_trains}; + $review{fgr_percent_h} = sprintf( '%.1f%%', $review{fgr_percent} ); + $review{fgr_percent_h} =~ tr{.}{,}; + $review{punctual_percent} = $num_punctual * 100 / $stats->{num_trains}; + $review{punctual_percent_h} + = sprintf( '%.1f%%', $review{punctual_percent} ); + $review{punctual_percent_h} =~ tr{.}{,}; + + my $top_trip_count = 0; + my $single_trip_count = 0; + for my $i ( 0 .. 3 ) { + if ( $trips[$i] ) { + my ( $from, $to ) = split( qr{[|]}, $trips[$i][0] ); + my $found = 0; + for my $j ( 0 .. $#{ $review{top_trips} } ) { + if ( $review{top_trips}[$j][0] eq $to + and $review{top_trips}[$j][2] eq $from ) + { + $review{top_trips}[$j][1] = '↔'; + $found = 1; + last; + } + } + if ( not $found ) { + push( @{ $review{top_trips} }, [ $from, '→', $to ] ); + } + $top_trip_count += $trips[$i][1]; + } + } + + for my $trip (@trips) { + if ( $trip->[1] == 1 ) { + $single_trip_count += 1; + if ( @{ $review{single_trips} // [] } < 3 ) { + push( + @{ $review{single_trips} }, + [ split( qr{[|]}, $trip->[0] ) ] + ); + } + } } - return ( $distance_polyline, $distance_intermediate, - $distance_beeline, $skipped ); + $review{top_trip_count} = $top_trip_count; + $review{top_trip_percent_h} + = sprintf( '%.1f%%', $top_trip_count * 100 / $stats->{num_trains} ); + $review{top_trip_percent_h} =~ tr{.}{,}; + + $review{single_trip_count} = $single_trip_count; + $review{single_trip_percent_h} + = sprintf( '%.1f%%', $single_trip_count * 100 / $stats->{num_trains} ); + $review{single_trip_percent_h} =~ tr{.}{,}; + + return \%review; } sub compute_stats { @@ -1041,6 +1677,8 @@ sub compute_stats { my @inconsistencies; my $next_departure = 0; + my $next_id; + my $next_train; for my $journey (@journeys) { $num_trains++; @@ -1069,8 +1707,27 @@ sub compute_stats { and $next_departure - $journey->{rt_arr_ts} < ( 60 * 60 ) ) { if ( $next_departure - $journey->{rt_arr_ts} < 0 ) { - push( @inconsistencies, - epoch_to_dt($next_departure)->strftime('%d.%m.%Y %H:%M') ); + push( + @inconsistencies, + { + conflict => { + train => ( + $journey->{is_motis} ? '' : $journey->{type} + ) + . ' ' + . ( $journey->{line} // $journey->{no} ), + arr => epoch_to_dt( $journey->{rt_arr_ts} ) + ->strftime('%d.%m.%Y %H:%M'), + id => $journey->{id}, + }, + ignored => { + train => $next_train, + dep => epoch_to_dt($next_departure) + ->strftime('%d.%m.%Y %H:%M'), + id => $next_id, + }, + } + ); } else { $interchange_real @@ -1081,6 +1738,10 @@ sub compute_stats { $num_journeys++; } $next_departure = $journey->{rt_dep_ts}; + $next_id = $journey->{id}; + $next_train + = ( $journey->{is_motis} ? '' : $journey->{type} ) . ' ' + . ( $journey->{line} // $journey->{no} ),; } my $ret = { km_route => $km_route, @@ -1113,6 +1774,8 @@ sub compute_stats { sub get_stats { my ( $self, %opt ) = @_; + $self->{log}->debug("get_stats"); + if ( $opt{cancelled} ) { $self->{log} ->warn('get_journey_stats called with illegal option cancelled => 1'); @@ -1120,8 +1783,8 @@ sub get_stats { } my $uid = $opt{uid}; - my $db = $opt{db} // $self->{pg}->db; - my $year = $opt{year} // 0; + my $db = $opt{db} // $self->{pg}->db; + my $year = $opt{year} // 0; my $month = $opt{month} // 0; # Assumption: If the stats cache contains an entry it is up-to-date. @@ -1129,7 +1792,8 @@ sub get_stats { # checks out of a train or manually edits/adds a journey. if ( - not $opt{write_only} + not $opt{write_only} + and not $opt{review} and my $stats = $self->stats_cache->get( uid => $uid, db => $db, @@ -1138,9 +1802,12 @@ sub get_stats { ) ) { + $self->{log}->debug("got cached journey stats for $year/$month"); return $stats; } + $self->{log}->debug("computing journey stats for $year/$month"); + my $interval_start = DateTime->new( time_zone => 'Europe/Berlin', year => 2000, @@ -1168,7 +1835,7 @@ sub get_stats { my @journeys = $self->get( uid => $uid, - cancelled => $opt{cancelled} ? 1 : 0, + cancelled => 0, verbose => 1, with_polyline => 1, after => $interval_start, @@ -1184,7 +1851,124 @@ sub get_stats { stats => $stats ); + if ( $opt{review} ) { + my @cancelled_journeys = $self->get( + uid => $uid, + cancelled => 1, + verbose => 1, + after => $interval_start, + before => $interval_end + ); + return ( $stats, + $self->compute_review( $stats, @journeys, @cancelled_journeys ) ); + } + return $stats; } +sub get_latest_dest_ids { + my ( $self, %opt ) = @_; + + my $uid = $opt{uid}; + my $db = $opt{db} // $self->{pg}->db; + + if ( + my ( $id, $backend_id ) = $self->{in_transit}->get_checkout_ids( + uid => $uid, + db => $db + ) + ) + { + return ( $id, $backend_id ); + } + + return $self->get_latest_checkout_ids( + uid => $uid, + db => $db + ); +} + +# Returns a listref of {eva, name} hashrefs for the specified backend. +sub get_connection_targets { + my ( $self, %opt ) = @_; + + 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}; + + if ( $opt{destination_name} ) { + return { + eva => $opt{eva}, + name => $opt{destination_name} + }; + } + + my $backend_id = $opt{backend_id}; + + if ( not $dest_id ) { + ( $dest_id, $backend_id ) = $self->get_latest_dest_ids(%opt); + } + + if ( not $dest_id ) { + return; + } + + my $dest_ids = [ + $dest_id, + $self->{stations}->get_meta( + eva => $dest_id, + backend_id => $backend_id, + ) + ]; + + my $res = $db->select( + 'journeys', + 'count(checkout_station_id) as count, checkout_station_id as dest', + { + user_id => $uid, + checkin_station_id => $dest_ids, + real_departure => { '>', $threshold }, + backend_id => $opt{backend_id}, + }, + { + group_by => ['checkout_station_id'], + order_by => { -desc => 'count' } + } + ); + my @destinations + = $res->hashes->grep( sub { shift->{count} >= $min_count } ) + ->map( sub { shift->{dest} } ) + ->each; + @destinations = $self->{stations}->get_by_evas( + backend_id => $opt{backend_id}, + evas => [@destinations] + ); + return @destinations; +} + +sub update_visibility { + my ( $self, %opt ) = @_; + + my $uid = $opt{uid}; + my $db = $opt{db} // $self->{pg}->db; + + my $visibility; + + if ( $opt{visibility} and $visibility_atoi{ $opt{visibility} } ) { + $visibility = $visibility_atoi{ $opt{visibility} }; + } + + $db->update( + 'journeys', + { visibility => $visibility }, + { + user_id => $uid, + id => $opt{id} + } + ); +} + 1; |