From 5f8332567182d1d44b5e79a5128f7babc754575e Mon Sep 17 00:00:00 2001 From: Daniel Friesel Date: Mon, 23 Dec 2019 16:56:32 +0100 Subject: Wagenreihung: Add train_powertype accessor --- lib/Travel/Status/DE/DBWagenreihung.pm | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/lib/Travel/Status/DE/DBWagenreihung.pm b/lib/Travel/Status/DE/DBWagenreihung.pm index e4f1d6c..2289383 100644 --- a/lib/Travel/Status/DE/DBWagenreihung.pm +++ b/lib/Travel/Status/DE/DBWagenreihung.pm @@ -265,6 +265,39 @@ sub train_no { return $self->{data}{istformation}{zugnummer}; } +sub train_powertype { + my ($self) = @_; + + if ( exists $self->{train_powertype} ) { + return $self->{train_powertype}; + } + + my @wagons = $self->wagons; + my %ml = map { $_ => 0 } ( 90 .. 99 ); + + for my $wagon (@wagons) { + + if ( not $wagon->uic_id or length( $wagon->uic_id ) != 12 ) { + next; + } + + my $wagon_type = substr( $wagon->uic_id, 0, 2 ); + if ( $wagon_type < 90 ) { + next; + } + + $ml{$wagon_type}++; + } + + my @likelihood = reverse sort { $ml{$a} <=> $ml{$b} } keys %ml; + + if ( $ml{ $likelihood[0] } == 0 ) { + return $self->{train_powertype} = undef; + } + + return $self->{train_powertype} = $likelihood[0]; +} + sub train_subtype { my ($self) = @_; -- cgit v1.2.3