EFA support (WiP)efa-support

12 files changed, 234 insertions, 11 deletions

diff --git a/cpanfile b/cpanfile
index 673b738..214c309 100644
--- a/cpanfile
+++ b/cpanfile
@@ -16,6 +16,7 @@ requires 'Mojo::Pg';
 requires 'Text::CSV';
 requires 'Text::Markdown';
 requires 'Travel::Status::DE::DBWagenreihung', '== 0.18';
+requires 'Travel::Status::DE::EFA';
 requires 'Travel::Status::DE::HAFAS', '>= 5.03';
 requires 'Travel::Status::DE::IRIS';
 requires 'UUID::Tiny';
diff --git a/lib/Travelynx.pm b/lib/Travelynx.pm
index c73f96d..0c8ceec 100755
--- a/lib/Travelynx.pm
+++ b/lib/Travelynx.pm
@@ -21,6 +21,7 @@ use List::UtilsBy   qw(uniq_by);
 use List::MoreUtils qw(first_index);
 use Travel::Status::DE::DBWagenreihung;
 use Travelynx::Helper::DBDB;
+use Travelynx::Helper::EFA;
 use Travelynx::Helper::HAFAS;
 use Travelynx::Helper::IRIS;
 use Travelynx::Helper::Sendmail;
@@ -157,11 +158,12 @@ sub startup {
 		cache_iris_main => sub {
 			my ($self) = @_;
 
-			return Cache::File->new(
+			state $cache = Cache::File->new(
 				cache_root      => $self->app->config->{cache}->{schedule},
 				default_expires => '6 hours',
 				lock_level      => Cache::File::LOCK_LOCAL(),
 			);
+			return $cache;
 		}
 	);
 
@@ -169,11 +171,12 @@ sub startup {
 		cache_iris_rt => sub {
 			my ($self) = @_;
 
-			return Cache::File->new(
+			state $cache = Cache::File->new(
 				cache_root      => $self->app->config->{cache}->{realtime},
 				default_expires => '70 seconds',
 				lock_level      => Cache::File::LOCK_LOCAL(),
 			);
+			return $cache;
 		}
 	);
 
@@ -191,7 +194,7 @@ sub startup {
 
 	$self->attr(
 		renamed_station => sub {
-			my $legacy_to_new = JSON->new->utf8->decode(
+			state $legacy_to_new = JSON->new->utf8->decode(
 				scalar read_file('share/old_station_names.json') );
 			return $legacy_to_new;
 		}
@@ -217,6 +220,21 @@ sub startup {
 	);
 
 	$self->helper(
+		efa => sub {
+			my ($self) = @_;
+			state $efa = Travelynx::Helper::EFA->new(
+				log            => $self->app->log,
+				main_cache     => $self->app->cache_iris_main,
+				realtime_cache => $self->app->cache_iris_rt,
+				root_url       => $self->base_url_for('/')->to_abs,
+				user_agent     => $self->ua,
+				version        => $self->app->config->{version},
+			);
+		}
+	);
+
+
+	$self->helper(
 		hafas => sub {
 			my ($self) = @_;
 			state $hafas = Travelynx::Helper::HAFAS->new(
diff --git a/lib/Travelynx/Command/database.pm b/lib/Travelynx/Command/database.pm
index a7d13a8..f9a2f1e 100644
--- a/lib/Travelynx/Command/database.pm
+++ b/lib/Travelynx/Command/database.pm
@@ -9,6 +9,7 @@ use DateTime;
 use File::Slurp qw(read_file);
 use List::Util  qw();
 use JSON;
+use Travel::Status::DE::EFA;
 use Travel::Status::DE::HAFAS;
 use Travel::Status::DE::IRIS::Stations;
 
@@ -2689,6 +2690,19 @@ qq{select distinct checkout_station_id from in_transit where backend_id = 0;}
 			}
 		);
 	},
+
+	# v58 -> v59
+	# Add EFA backend support
+	sub {
+		my ($db) = @_;
+		$db->query(
+			qq{
+				alter table schema_version add column efa varchar(12);
+				update schema_version set version = 59;
+				update schema_version set efa = '0';
+			}
+		);
+	},
 );
 
 sub sync_stations {
@@ -2879,7 +2893,37 @@ sub sync_stations {
 	}
 }
 
-sub sync_backends {
+sub sync_efa {
+	my ($db) = @_;
+	for my $service ( Travel::Status::DE::EFA::get_services() ) {
+		my $present = $db->select(
+			'backends',
+			'count(*) as count',
+			{
+				efa => 1,
+				name  => $service->{shortname}
+			}
+		)->hash->{count};
+		if ( not $present ) {
+			$db->insert(
+				'backends',
+				{
+					iris  => 0,
+					hafas => 0,
+					efa   => 1,
+					ris   => 0,
+					name  => $service->{shortname},
+				},
+				{ on_conflict => undef }
+			);
+		}
+	}
+
+	$db->update( 'schema_version',
+		{ efa => $Travel::Status::DE::EFA::VERSION } );
+}
+
+sub sync_hafas {
 	my ($db) = @_;
 	for my $service ( Travel::Status::DE::HAFAS::get_services() ) {
 		my $present = $db->select(
@@ -2996,6 +3040,17 @@ sub migrate_db {
 		}
 	}
 
+	my $efa_version = get_schema_version( $db, 'efa' );
+	say "Found backend table for EFA v${efa_version}";
+	if ( $efa_version eq $Travel::Status::DE::EFA::VERSION ) {
+		say 'Backend table is up-to-date';
+	}
+	else {
+		say
+"Synchronizing with Travel::Status::DE::EFA $Travel::Status::DE::EFA::VERSION";
+		sync_efa($db);
+	}
+
 	my $hafas_version = get_schema_version( $db, 'hafas' );
 	say "Found backend table for HAFAS v${hafas_version}";
 	if ( $hafas_version eq $Travel::Status::DE::HAFAS::VERSION ) {
@@ -3004,7 +3059,7 @@ sub migrate_db {
 	else {
 		say
 "Synchronizing with Travel::Status::DE::HAFAS $Travel::Status::DE::HAFAS::VERSION";
-		sync_backends($db);
+		sync_hafas($db);
 	}
 
 	$db->update( 'schema_version',
diff --git a/lib/Travelynx/Controller/Account.pm b/lib/Travelynx/Controller/Account.pm
index faaad0a..97a3cf6 100644
--- a/lib/Travelynx/Controller/Account.pm
+++ b/lib/Travelynx/Controller/Account.pm
@@ -1069,6 +1069,48 @@ sub backend_form {
 			$backend->{longname} = 'Deutsche Bahn (IRIS-TTS)';
 			$backend->{homepage} = 'https://www.bahn.de';
 		}
+		elsif ( $backend->{efa} ) {
+			if ( my $s = $self->efa->get_service( $backend->{name} ) ) {
+				$type                = 'EFA';
+				$backend->{longname} = $s->{name};
+				$backend->{homepage} = $s->{homepage};
+				$backend->{regions}  = [ map { $place_map{$_} // $_ }
+					  @{ $s->{coverage}{regions} // [] } ];
+				$backend->{has_area} = $s->{coverage}{area} ? 1 : 0;
+
+				if (
+					    $s->{coverage}{area}
+					and $s->{coverage}{area}{type} eq 'Polygon'
+					and $self->lonlat_in_polygon(
+						$s->{coverage}{area}{coordinates},
+						[ $user_lon, $user_lat ]
+					)
+				  )
+				{
+					push( @suggested_backends, $backend );
+				}
+				elsif ( $s->{coverage}{area}
+					and $s->{coverage}{area}{type} eq 'MultiPolygon' )
+				{
+					for my $s_poly (
+						@{ $s->{coverage}{area}{coordinates} // [] } )
+					{
+						if (
+							$self->lonlat_in_polygon(
+								$s_poly, [ $user_lon, $user_lat ]
+							)
+						  )
+						{
+							push( @suggested_backends, $backend );
+							last;
+						}
+					}
+				}
+			}
+			else {
+				$type = undef;
+			}
+		}
 		elsif ( $backend->{hafas} ) {
 			if ( my $s = $self->hafas->get_service( $backend->{name} ) ) {
 				$type                = 'HAFAS';
diff --git a/lib/Travelynx/Controller/Traveling.pm b/lib/Travelynx/Controller/Traveling.pm
index f61d83d..53d28a9 100755
--- a/lib/Travelynx/Controller/Traveling.pm
+++ b/lib/Travelynx/Controller/Traveling.pm
@@ -917,6 +917,8 @@ sub station {
 		$timestamp = DateTime->now( time_zone => 'Europe/Berlin' );
 	}
 
+	my $efa_service = $self->param('efa')
+	  // ( $user->{backend_efa} ? $user->{backend_name} : undef );
 	my $hafas_service = $self->param('hafas')
 	  // ( $user->{backend_hafas} ? $user->{backend_name} : undef );
 	my $promise;
@@ -929,6 +931,15 @@ sub station {
 			lookahead  => 30,
 		);
 	}
+	elsif ($efa_service) {
+		$promise = $self->efa->get_departures_p(
+			service    => $efa_service,
+			name       => $station,
+			timestamp  => $timestamp,
+			lookbehind => 10,
+			lookahead  => 30,
+		);
+	}
 	else {
 		$promise = $self->iris->get_departures_p(
 			station      => $station,
@@ -967,6 +978,16 @@ sub station {
 					related_stations => [],
 				};
 			}
+			elsif ($efa_service) {
+				@results = map { $_->[0] }
+				  sort { $b->[1] <=> $a->[1] }
+				  map { [ $_, $_->datetime->epoch ] } $status->results;
+				$status = {
+					station_eva => $status->stop->id,
+					station_name => $status->stop->full_name,
+					related_stations => [],
+				};
+			}
 			else {
 
 				# You can't check into a train which terminates here
@@ -1013,12 +1034,14 @@ sub station {
 						eva => $user_status->{cancellation}{dep_eva},
 						destination_name =>
 						  $user_status->{cancellation}{arr_name},
+						efa   => $efa_service,
 						hafas => $hafas_service,
 					);
 				}
 				else {
 					$connections_p = $self->get_connecting_trains_p(
 						eva   => $status->{station_eva},
+						efa   => $efa_service,
 						hafas => $hafas_service
 					);
 				}
@@ -1031,6 +1054,7 @@ sub station {
 						$self->render(
 							'departures',
 							user              => $user,
+							efa              => $efa_service,
 							hafas             => $hafas_service,
 							eva               => $status->{station_eva},
 							datetime          => $timestamp,
@@ -1050,6 +1074,7 @@ sub station {
 						$self->render(
 							'departures',
 							user             => $user,
+							efa              => $efa_service,
 							hafas            => $hafas_service,
 							eva              => $status->{station_eva},
 							datetime         => $timestamp,
@@ -1068,6 +1093,7 @@ sub station {
 				$self->render(
 					'departures',
 					user             => $user,
+					efa              => $efa_service,
 					hafas            => $hafas_service,
 					eva              => $status->{station_eva},
 					datetime         => $timestamp,
diff --git a/lib/Travelynx/Helper/EFA.pm b/lib/Travelynx/Helper/EFA.pm
new file mode 100644
index 0000000..54c633d
--- /dev/null
+++ b/lib/Travelynx/Helper/EFA.pm
@@ -0,0 +1,53 @@
+package Travelynx::Helper::EFA;
+
+# Copyright (C) 2024 Birte Kristina Friesel
+#
+# SPDX-License-Identifier: AGPL-3.0-or-later
+
+use strict;
+use warnings;
+use 5.020;
+
+use Travel::Status::DE::EFA;
+
+sub new {
+	my ( $class, %opt ) = @_;
+
+	my $version = $opt{version};
+
+	$opt{header}
+	  = { 'User-Agent' =>
+"travelynx/${version} on $opt{root_url} +https://finalrewind.org/projects/travelynx"
+	  };
+
+	return bless( \%opt, $class );
+}
+
+sub get_service {
+	my ( $self, $service ) = @_;
+
+	say "get_service $service";
+
+	return Travel::Status::DE::EFA::get_service($service);
+}
+
+sub get_departures_p {
+	my ( $self, %opt ) = @_;
+
+	my $when = (
+		  $opt{timestamp}
+		? $opt{timestamp}->clone
+		: DateTime->now( time_zone => 'Europe/Berlin' )
+	)->subtract( minutes => $opt{lookbehind} );
+	return Travel::Status::DE::EFA->new_p(
+		service     => $opt{service},
+		name        => $opt{name},
+		datetime    => $when,
+		full_routes => 1,
+		cache       => $self->{realtime_cache},
+		promise     => 'Mojo::Promise',
+		user_agent  => $self->{user_agent}->request_timeout(5),
+	);
+}
+
+1;
diff --git a/lib/Travelynx/Helper/HAFAS.pm b/lib/Travelynx/Helper/HAFAS.pm
index a8ab395..5b1ee81 100644
--- a/lib/Travelynx/Helper/HAFAS.pm
+++ b/lib/Travelynx/Helper/HAFAS.pm
@@ -33,6 +33,20 @@ sub new {
 	return bless( \%opt, $class );
 }
 
+sub class_to_product {
+	my ( $self, $hafas ) = @_;
+
+	my $bits = $hafas->get_active_service->{productbits};
+	my $ret;
+
+	for my $i ( 0 .. $#{$bits} ) {
+		$ret->{ 2**$i }
+		  = ref( $bits->[$i] ) eq 'ARRAY' ? $bits->[$i][0] : $bits->[$i];
+	}
+
+	return $ret;
+}
+
 sub get_service {
 	my ( $self, $service ) = @_;
 
diff --git a/lib/Travelynx/Model/Journeys.pm b/lib/Travelynx/Model/Journeys.pm
index 905c426..93e59e7 100755
--- a/lib/Travelynx/Model/Journeys.pm
+++ b/lib/Travelynx/Model/Journeys.pm
@@ -1722,6 +1722,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');
@@ -1748,9 +1750,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,
diff --git a/lib/Travelynx/Model/Stations.pm b/lib/Travelynx/Model/Stations.pm
index 76fd452..f4eb096 100644
--- a/lib/Travelynx/Model/Stations.pm
+++ b/lib/Travelynx/Model/Stations.pm
@@ -76,7 +76,7 @@ sub get_backends {
 
 	$opt{db} //= $self->{pg}->db;
 
-	my $res = $opt{db}->select( 'backends', [ 'id', 'name', 'iris', 'hafas' ] );
+	my $res = $opt{db}->select( 'backends', [ 'id', 'name', 'efa', 'hafas', 'iris' ] );
 	my @ret;
 
 	while ( my $row = $res->hash ) {
@@ -85,8 +85,9 @@ sub get_backends {
 			{
 				id    => $row->{id},
 				name  => $row->{name},
-				iris  => $row->{iris},
+				efa   => $row->{efa},
 				hafas => $row->{hafas},
+				iris  => $row->{iris},
 			}
 		);
 	}
diff --git a/lib/Travelynx/Model/Users.pm b/lib/Travelynx/Model/Users.pm
index 7d3777b..a672a38 100644
--- a/lib/Travelynx/Model/Users.pm
+++ b/lib/Travelynx/Model/Users.pm
@@ -209,7 +209,11 @@ sub set_backend {
 	my ( $self, %opt ) = @_;
 	$opt{db} //= $self->{pg}->db;
 
-	$opt{db}->update('users', {backend_id => $opt{backend_id}}, {id => $opt{uid}});
+	$opt{db}->update(
+		'users',
+		{ backend_id => $opt{backend_id} },
+		{ id         => $opt{uid} }
+	);
 }
 
 sub set_privacy {
@@ -414,7 +418,7 @@ sub get {
 		  . 'extract(epoch from registered_at) as registered_at_ts, '
 		  . 'extract(epoch from last_seen) as last_seen_ts, '
 		  . 'extract(epoch from deletion_requested) as deletion_requested_ts, '
-		  . 'backend_id, backend_name, hafas',
+		  . 'backend_id, backend_name, efa, hafas',
 		{ id => $uid }
 	)->hash;
 	if ($user) {
@@ -453,6 +457,7 @@ sub get {
 			: undef,
 			backend_id    => $user->{backend_id},
 			backend_name  => $user->{backend_name},
+			backend_efa   => $user->{efa},
 			backend_hafas => $user->{hafas},
 		};
 	}
diff --git a/templates/_backend_line.html.ep b/templates/_backend_line.html.ep
index 5f2bcf1..e640cfe 100644
--- a/templates/_backend_line.html.ep
+++ b/templates/_backend_line.html.ep
@@ -6,7 +6,7 @@
 		% }
 		% if ($backend->{has_area}) {
 			<br/>
-			<a href="https://dbf.finalrewind.org/coverage/HAFAS/<%= $backend->{name} %>"><%= join(q{, }, @{$backend->{regions} // []}) || '[Karte]' %></a>
+			<a href="https://dbf.finalrewind.org/coverage/<%= uc($backend->{type}) %>/<%= $backend->{name} %>"><%= join(q{, }, @{$backend->{regions} // []}) || '[Karte]' %></a>
 		% }
 		% elsif ($backend->{regions}) {
 			<br/>
diff --git a/templates/departures.html.ep b/templates/departures.html.ep
index a86a7b5..0c563de 100644
--- a/templates/departures.html.ep
+++ b/templates/departures.html.ep
@@ -139,7 +139,10 @@
 			% }
 		</p>
 		% if (not $user_status->{checked_in} or ($can_check_out and $user_status->{arr_eva} and $user_status->{arrival_countdown} <= 0)) {
-			% if ($hafas) {
+			% if ($efa) {
+				%= include '_departures_efa', results => $results, efa => $efa;
+			% }
+			% elsif ($hafas) {
 				%= include '_departures_hafas', results => $results, hafas => $hafas;
 			% }
 			% else {