Traveling: sort helpers <-> controllers
This commit is contained in:
Daniel Friesel
parent
de73024f1b
commit
c06d653195
1 changed files with 178 additions and 174 deletions
|
|
@ -14,6 +14,184 @@ use List::MoreUtils qw(first_index);
|
||||||
use Text::CSV;
|
use Text::CSV;
|
||||||
use Travel::Status::DE::IRIS::Stations;
|
use Travel::Status::DE::IRIS::Stations;
|
||||||
|
|
||||||
|
# Internal Helpers
|
||||||
|
|
||||||
|
sub has_str_in_list {
|
||||||
|
my ( $str, @strs ) = @_;
|
||||||
|
if ( List::Util::any { $str eq $_ } @strs ) {
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_connecting_trains {
|
||||||
|
my ( $self, %opt ) = @_;
|
||||||
|
|
||||||
|
my $uid = $opt{uid} //= $self->current_user->{id};
|
||||||
|
my $use_history = $self->users->use_history( uid => $uid );
|
||||||
|
|
||||||
|
my ( $eva, $exclude_via, $exclude_train_id, $exclude_before );
|
||||||
|
my $now = $self->now->epoch;
|
||||||
|
my ( $stationinfo, $arr_epoch, $arr_platform );
|
||||||
|
|
||||||
|
if ( $opt{eva} ) {
|
||||||
|
if ( $use_history & 0x01 ) {
|
||||||
|
$eva = $opt{eva};
|
||||||
|
}
|
||||||
|
elsif ( $opt{destination_name} ) {
|
||||||
|
$eva = $opt{eva};
|
||||||
|
}
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
if ( $use_history & 0x02 ) {
|
||||||
|
my $status = $self->get_user_status;
|
||||||
|
$eva = $status->{arr_eva};
|
||||||
|
$exclude_via = $status->{dep_name};
|
||||||
|
$exclude_train_id = $status->{train_id};
|
||||||
|
$arr_platform = $status->{arr_platform};
|
||||||
|
$stationinfo = $status->{extra_data}{stationinfo_arr};
|
||||||
|
if ( $status->{real_arrival} ) {
|
||||||
|
$exclude_before = $arr_epoch = $status->{real_arrival}->epoch;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
$exclude_before //= $now - 300;
|
||||||
|
|
||||||
|
if ( not $eva ) {
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
my @destinations = $self->journeys->get_connection_targets(%opt);
|
||||||
|
|
||||||
|
if ($exclude_via) {
|
||||||
|
@destinations = grep { $_ ne $exclude_via } @destinations;
|
||||||
|
}
|
||||||
|
|
||||||
|
if ( not @destinations ) {
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
my $stationboard = $self->iris->get_departures(
|
||||||
|
station => $eva,
|
||||||
|
lookbehind => 10,
|
||||||
|
lookahead => 40,
|
||||||
|
with_related => 1
|
||||||
|
);
|
||||||
|
if ( $stationboard->{errstr} ) {
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
@{ $stationboard->{results} } = map { $_->[0] }
|
||||||
|
sort { $a->[1] <=> $b->[1] }
|
||||||
|
map { [ $_, $_->departure ? $_->departure->epoch : 0 ] }
|
||||||
|
@{ $stationboard->{results} };
|
||||||
|
my @results;
|
||||||
|
my @cancellations;
|
||||||
|
my %via_count = map { $_ => 0 } @destinations;
|
||||||
|
for my $train ( @{ $stationboard->{results} } ) {
|
||||||
|
if ( not $train->departure ) {
|
||||||
|
next;
|
||||||
|
}
|
||||||
|
if ( $exclude_before
|
||||||
|
and $train->departure
|
||||||
|
and $train->departure->epoch < $exclude_before )
|
||||||
|
{
|
||||||
|
next;
|
||||||
|
}
|
||||||
|
if ( $exclude_train_id
|
||||||
|
and $train->train_id eq $exclude_train_id )
|
||||||
|
{
|
||||||
|
next;
|
||||||
|
}
|
||||||
|
|
||||||
|
# In general, this function is meant to return feasible
|
||||||
|
# connections. However, cancelled connections may also be of
|
||||||
|
# interest and are also useful for logging cancellations.
|
||||||
|
# To satisfy both demands with (hopefully) little confusion and
|
||||||
|
# UI clutter, this function returns two concatenated arrays:
|
||||||
|
# actual connections (ordered by actual departure time) followed
|
||||||
|
# by cancelled connections (ordered by scheduled departure time).
|
||||||
|
# This is easiest to achieve in two separate loops.
|
||||||
|
#
|
||||||
|
# Note that a cancelled train may still have a matching destination
|
||||||
|
# in its route_post, e.g. if it leaves out $eva due to
|
||||||
|
# unscheduled route changes but continues on schedule afterwards
|
||||||
|
# -- so it is only cancelled at $eva, not on the remainder of
|
||||||
|
# the route. Also note that this specific case is not yet handled
|
||||||
|
# properly by the cancellation logic etc.
|
||||||
|
|
||||||
|
if ( $train->departure_is_cancelled ) {
|
||||||
|
my @via = ( $train->sched_route_post, $train->sched_route_end );
|
||||||
|
for my $dest (@destinations) {
|
||||||
|
if ( List::Util::any { $_ eq $dest } @via ) {
|
||||||
|
push( @cancellations, [ $train, $dest ] );
|
||||||
|
next;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
my @via = ( $train->route_post, $train->route_end );
|
||||||
|
for my $dest (@destinations) {
|
||||||
|
if ( $via_count{$dest} < 2
|
||||||
|
and List::Util::any { $_ eq $dest } @via )
|
||||||
|
{
|
||||||
|
push( @results, [ $train, $dest ] );
|
||||||
|
|
||||||
|
# Show all past and up to two future departures per destination
|
||||||
|
if ( not $train->departure
|
||||||
|
or $train->departure->epoch >= $now )
|
||||||
|
{
|
||||||
|
$via_count{$dest}++;
|
||||||
|
}
|
||||||
|
next;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
@results = map { $_->[0] }
|
||||||
|
sort { $a->[1] <=> $b->[1] }
|
||||||
|
map {
|
||||||
|
[ $_, $_->[0]->departure->epoch // $_->[0]->sched_departure->epoch ]
|
||||||
|
} @results;
|
||||||
|
@cancellations = map { $_->[0] }
|
||||||
|
sort { $a->[1] <=> $b->[1] }
|
||||||
|
map { [ $_, $_->[0]->sched_departure->epoch ] } @cancellations;
|
||||||
|
|
||||||
|
for my $result (@results) {
|
||||||
|
my $train = $result->[0];
|
||||||
|
my @message_ids = List::Util::uniq map { $_->[1] } $train->raw_messages;
|
||||||
|
$train->{message_id} = { map { $_ => 1 } @message_ids };
|
||||||
|
my $interchange_duration;
|
||||||
|
if ( exists $stationinfo->{i} ) {
|
||||||
|
$interchange_duration
|
||||||
|
= $stationinfo->{i}{$arr_platform}{ $train->platform };
|
||||||
|
$interchange_duration //= $stationinfo->{i}{"*"};
|
||||||
|
}
|
||||||
|
if ( defined $interchange_duration ) {
|
||||||
|
my $interchange_time
|
||||||
|
= ( $train->departure->epoch - $arr_epoch ) / 60;
|
||||||
|
if ( $interchange_time < $interchange_duration ) {
|
||||||
|
$train->{interchange_text} = 'Anschluss knapp';
|
||||||
|
$train->{interchange_icon} = 'warning';
|
||||||
|
}
|
||||||
|
elsif ( $interchange_time == $interchange_duration ) {
|
||||||
|
$train->{interchange_text} = 'Anschluss könnte knapp werden';
|
||||||
|
$train->{interchange_icon} = 'directions_run';
|
||||||
|
}
|
||||||
|
|
||||||
|
#else {
|
||||||
|
# $train->{interchange_text} = 'Anschluss wird voraussichtlich erreicht';
|
||||||
|
# $train->{interchange_icon} = 'check';
|
||||||
|
#}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return ( @results, @cancellations );
|
||||||
|
}
|
||||||
|
|
||||||
|
# Controllers
|
||||||
|
|
||||||
sub homepage {
|
sub homepage {
|
||||||
my ($self) = @_;
|
my ($self) = @_;
|
||||||
if ( $self->is_user_authenticated ) {
|
if ( $self->is_user_authenticated ) {
|
||||||
|
|
@ -852,14 +1030,6 @@ sub commute {
|
||||||
);
|
);
|
||||||
}
|
}
|
||||||
|
|
||||||
sub has_str_in_list {
|
|
||||||
my ( $str, @strs ) = @_;
|
|
||||||
if ( List::Util::any { $str eq $_ } @strs ) {
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub map_history {
|
sub map_history {
|
||||||
my ($self) = @_;
|
my ($self) = @_;
|
||||||
|
|
||||||
|
|
@ -1476,170 +1646,4 @@ sub add_journey_form {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
sub get_connecting_trains {
|
|
||||||
my ( $self, %opt ) = @_;
|
|
||||||
|
|
||||||
my $uid = $opt{uid} //= $self->current_user->{id};
|
|
||||||
my $use_history = $self->users->use_history( uid => $uid );
|
|
||||||
|
|
||||||
my ( $eva, $exclude_via, $exclude_train_id, $exclude_before );
|
|
||||||
my $now = $self->now->epoch;
|
|
||||||
my ( $stationinfo, $arr_epoch, $arr_platform );
|
|
||||||
|
|
||||||
if ( $opt{eva} ) {
|
|
||||||
if ( $use_history & 0x01 ) {
|
|
||||||
$eva = $opt{eva};
|
|
||||||
}
|
|
||||||
elsif ( $opt{destination_name} ) {
|
|
||||||
$eva = $opt{eva};
|
|
||||||
}
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
if ( $use_history & 0x02 ) {
|
|
||||||
my $status = $self->get_user_status;
|
|
||||||
$eva = $status->{arr_eva};
|
|
||||||
$exclude_via = $status->{dep_name};
|
|
||||||
$exclude_train_id = $status->{train_id};
|
|
||||||
$arr_platform = $status->{arr_platform};
|
|
||||||
$stationinfo = $status->{extra_data}{stationinfo_arr};
|
|
||||||
if ( $status->{real_arrival} ) {
|
|
||||||
$exclude_before = $arr_epoch = $status->{real_arrival}->epoch;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
$exclude_before //= $now - 300;
|
|
||||||
|
|
||||||
if ( not $eva ) {
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
|
|
||||||
my @destinations = $self->journeys->get_connection_targets(%opt);
|
|
||||||
|
|
||||||
if ($exclude_via) {
|
|
||||||
@destinations = grep { $_ ne $exclude_via } @destinations;
|
|
||||||
}
|
|
||||||
|
|
||||||
if ( not @destinations ) {
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
|
|
||||||
my $stationboard = $self->iris->get_departures(
|
|
||||||
station => $eva,
|
|
||||||
lookbehind => 10,
|
|
||||||
lookahead => 40,
|
|
||||||
with_related => 1
|
|
||||||
);
|
|
||||||
if ( $stationboard->{errstr} ) {
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
@{ $stationboard->{results} } = map { $_->[0] }
|
|
||||||
sort { $a->[1] <=> $b->[1] }
|
|
||||||
map { [ $_, $_->departure ? $_->departure->epoch : 0 ] }
|
|
||||||
@{ $stationboard->{results} };
|
|
||||||
my @results;
|
|
||||||
my @cancellations;
|
|
||||||
my %via_count = map { $_ => 0 } @destinations;
|
|
||||||
for my $train ( @{ $stationboard->{results} } ) {
|
|
||||||
if ( not $train->departure ) {
|
|
||||||
next;
|
|
||||||
}
|
|
||||||
if ( $exclude_before
|
|
||||||
and $train->departure
|
|
||||||
and $train->departure->epoch < $exclude_before )
|
|
||||||
{
|
|
||||||
next;
|
|
||||||
}
|
|
||||||
if ( $exclude_train_id
|
|
||||||
and $train->train_id eq $exclude_train_id )
|
|
||||||
{
|
|
||||||
next;
|
|
||||||
}
|
|
||||||
|
|
||||||
# In general, this function is meant to return feasible
|
|
||||||
# connections. However, cancelled connections may also be of
|
|
||||||
# interest and are also useful for logging cancellations.
|
|
||||||
# To satisfy both demands with (hopefully) little confusion and
|
|
||||||
# UI clutter, this function returns two concatenated arrays:
|
|
||||||
# actual connections (ordered by actual departure time) followed
|
|
||||||
# by cancelled connections (ordered by scheduled departure time).
|
|
||||||
# This is easiest to achieve in two separate loops.
|
|
||||||
#
|
|
||||||
# Note that a cancelled train may still have a matching destination
|
|
||||||
# in its route_post, e.g. if it leaves out $eva due to
|
|
||||||
# unscheduled route changes but continues on schedule afterwards
|
|
||||||
# -- so it is only cancelled at $eva, not on the remainder of
|
|
||||||
# the route. Also note that this specific case is not yet handled
|
|
||||||
# properly by the cancellation logic etc.
|
|
||||||
|
|
||||||
if ( $train->departure_is_cancelled ) {
|
|
||||||
my @via = ( $train->sched_route_post, $train->sched_route_end );
|
|
||||||
for my $dest (@destinations) {
|
|
||||||
if ( List::Util::any { $_ eq $dest } @via ) {
|
|
||||||
push( @cancellations, [ $train, $dest ] );
|
|
||||||
next;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
my @via = ( $train->route_post, $train->route_end );
|
|
||||||
for my $dest (@destinations) {
|
|
||||||
if ( $via_count{$dest} < 2
|
|
||||||
and List::Util::any { $_ eq $dest } @via )
|
|
||||||
{
|
|
||||||
push( @results, [ $train, $dest ] );
|
|
||||||
|
|
||||||
# Show all past and up to two future departures per destination
|
|
||||||
if ( not $train->departure
|
|
||||||
or $train->departure->epoch >= $now )
|
|
||||||
{
|
|
||||||
$via_count{$dest}++;
|
|
||||||
}
|
|
||||||
next;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
@results = map { $_->[0] }
|
|
||||||
sort { $a->[1] <=> $b->[1] }
|
|
||||||
map {
|
|
||||||
[ $_, $_->[0]->departure->epoch // $_->[0]->sched_departure->epoch ]
|
|
||||||
} @results;
|
|
||||||
@cancellations = map { $_->[0] }
|
|
||||||
sort { $a->[1] <=> $b->[1] }
|
|
||||||
map { [ $_, $_->[0]->sched_departure->epoch ] } @cancellations;
|
|
||||||
|
|
||||||
for my $result (@results) {
|
|
||||||
my $train = $result->[0];
|
|
||||||
my @message_ids = List::Util::uniq map { $_->[1] } $train->raw_messages;
|
|
||||||
$train->{message_id} = { map { $_ => 1 } @message_ids };
|
|
||||||
my $interchange_duration;
|
|
||||||
if ( exists $stationinfo->{i} ) {
|
|
||||||
$interchange_duration
|
|
||||||
= $stationinfo->{i}{$arr_platform}{ $train->platform };
|
|
||||||
$interchange_duration //= $stationinfo->{i}{"*"};
|
|
||||||
}
|
|
||||||
if ( defined $interchange_duration ) {
|
|
||||||
my $interchange_time
|
|
||||||
= ( $train->departure->epoch - $arr_epoch ) / 60;
|
|
||||||
if ( $interchange_time < $interchange_duration ) {
|
|
||||||
$train->{interchange_text} = 'Anschluss knapp';
|
|
||||||
$train->{interchange_icon} = 'warning';
|
|
||||||
}
|
|
||||||
elsif ( $interchange_time == $interchange_duration ) {
|
|
||||||
$train->{interchange_text} = 'Anschluss könnte knapp werden';
|
|
||||||
$train->{interchange_icon} = 'directions_run';
|
|
||||||
}
|
|
||||||
|
|
||||||
#else {
|
|
||||||
# $train->{interchange_text} = 'Anschluss wird voraussichtlich erreicht';
|
|
||||||
# $train->{interchange_icon} = 'check';
|
|
||||||
#}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
return ( @results, @cancellations );
|
|
||||||
}
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue