Unverified Commit 37db8fb0 authored by Birte Kristina Friesel's avatar Birte Kristina Friesel
Browse files

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
parent 46bacf67

lib/Travel/Status/DE/DBRIS/Journey.pm

+28 −2
Original line number Diff line number Diff line
@@ -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 ) {

lib/Travel/Status/DE/DBRIS/Location.pm

+2 −1
Original line number Diff line number Diff line
@@ -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},