Avoid overriding train type with trip number in some cases (e.g. TRI)

Also improves the overall trip type handling, and introduces trip_type_at
accessor similar to trip_no_at.

Closes #12

2 files changed, 30 insertions, 3 deletions

diff --git a/lib/Travel/Status/DE/DBRIS/Journey.pm b/lib/Travel/Status/DE/DBRIS/Journey.pm
index 8182a5f..f85c3c3 100644
--- a/lib/Travel/Status/DE/DBRIS/Journey.pm
+++ b/lib/Travel/Status/DE/DBRIS/Journey.pm
@@ -35,6 +35,7 @@ sub new {
 	if ( $json->{halte} and @{ $json->{halte} } ) {
 		my %admin_id_ml;
 		my %trip_no_ml;
+		my %type_ml;
 
 		for my $stop ( @{ $json->{halte} } ) {
 			if ( defined $stop->{adminID} ) {
@@ -43,6 +44,9 @@ sub new {
 			if ( defined $stop->{nummer} ) {
 				$trip_no_ml{ $stop->{nummer} } += 1;
 			}
+			if ( defined $stop->{kategorie} ) {
+				$type_ml{ $stop->{kategorie} } += 1;
+			}
 		}
 
 		if (%admin_id_ml) {
@@ -70,6 +74,13 @@ sub new {
 			];
 		}
 
+		if (%type_ml) {
+			my @type_argmax
+			  = reverse sort { $type_ml{$a} <=> $type_ml{$b} } keys %type_ml;
+			$ref->{type}  = $type_argmax[0];
+			$ref->{types} = \@type_argmax;
+		}
+
 		if (%trip_no_ml) {
 			my @trip_no_argmax
 			  = reverse sort { $trip_no_ml{$a} <=> $trip_no_ml{$b} }
@@ -82,14 +93,14 @@ sub new {
 	# Number is either train no (ICE, RE) or line no (S, U, Bus, ...)
 	# with no way of distinguishing between those
 	if ( $ref->{trip} ) {
-		( $ref->{type}, $ref->{number} ) = split( qr{\s+}, $ref->{trip} );
+		$ref->{number} = ( split( qr{\s+}, $ref->{trip} ) )[-1];
 	}
 
 	# For some trips, the type also contains the trip number like "MEX19161"
 	# If we can detect this, remove the number from the trip type
 	if (    $ref->{trip_no}
 		and $ref->{type}
-		and $ref->{type} =~ qr{ (?<actualtype> [^\d]+ ) $ref->{trip_no} $ }x )
+		and $ref->{type} =~ m{ (?<actualtype> [^\d]+ ) $ref->{trip_no} $ }x )
 	{
 		$ref->{type} = $+{actualtype};
 	}
@@ -229,6 +240,21 @@ sub trip_numbers {
 	return @{ $self->{trip_numbers} // [] };
 }
 
+sub type_at {
+	my ( $self, $loc, $ts ) = @_;
+	for my $stop ( $self->route ) {
+		if ( $stop->name eq $loc or $stop->eva eq $loc ) {
+			if (   not defined $ts
+				or not( $stop->sched_dep // $stop->sched_arr )
+				or ( $stop->sched_dep // $stop->sched_arr )->epoch == $ts )
+			{
+				return $stop->type;
+			}
+		}
+	}
+	return;
+}
+
 sub trip_no_at {
 	my ( $self, $loc, $ts ) = @_;
 	for my $stop ( $self->route ) {
diff --git a/lib/Travel/Status/DE/DBRIS/Location.pm b/lib/Travel/Status/DE/DBRIS/Location.pm
index 9eb356b..8a47054 100644
--- a/lib/Travel/Status/DE/DBRIS/Location.pm
+++ b/lib/Travel/Status/DE/DBRIS/Location.pm
@@ -10,7 +10,7 @@ our $VERSION = '0.18';
 
 Travel::Status::DE::DBRIS::Location->mk_ro_accessors(
 	qw(eva id lat lon name admin_id operator products type is_cancelled is_additional is_separation display_priority
-	  trip_no dep arr sched_dep sched_arr rt_dep rt_arr arr_delay dep_delay delay
+	  trip_no trip_type dep arr sched_dep sched_arr rt_dep rt_arr arr_delay dep_delay delay
 	  platform sched_platform rt_platform
 	  occupancy_first occupancy_second occupancy
 	)
@@ -36,6 +36,7 @@ sub new {
 		name           => $json->{name},
 		products       => $json->{products},
 		type           => $json->{type},
+		trip_type      => $json->{kategorie},
 		is_cancelled   => $json->{canceled},
 		is_additional  => $json->{additional},
 		sched_platform => $json->{gleis},