summaryrefslogtreecommitdiff
path: root/lib/Travel
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Travel')
-rw-r--r--lib/Travel/Status/DE/DBWagenreihung.pm180
1 files changed, 145 insertions, 35 deletions
diff --git a/lib/Travel/Status/DE/DBWagenreihung.pm b/lib/Travel/Status/DE/DBWagenreihung.pm
index 0519246..dcf1e8b 100644
--- a/lib/Travel/Status/DE/DBWagenreihung.pm
+++ b/lib/Travel/Status/DE/DBWagenreihung.pm
@@ -13,6 +13,65 @@ use LWP::UserAgent;
use Travel::Status::DE::DBWagenreihung::Section;
use Travel::Status::DE::DBWagenreihung::Wagon;
+my %is_redesign = (
+ "02" => 1,
+ "03" => 1,
+ "06" => 1,
+ "09" => 1,
+ "10" => 1,
+ "13" => 1,
+ "14" => 1,
+ "15" => 1,
+ "16" => 1,
+ "18" => 1,
+ "19" => 1,
+ "20" => 1,
+ "23" => 1,
+ "24" => 1,
+ "27" => 1,
+ "28" => 1,
+ "29" => 1,
+ "31" => 1,
+ "32" => 1,
+ "33" => 1,
+ "34" => 1,
+ "35" => 1,
+ "36" => 1,
+ "37" => 1,
+ "53" => 1
+);
+
+my %model_name = (
+ '401' => ['ICE 1'],
+ '402' => ['ICE 2'],
+ '403.S1' => [ 'ICE 3', 'BR 403, 1. Serie' ],
+ '403.S2' => [ 'ICE 3', 'BR 403, 2. Serie' ],
+ '403.R' => [ 'ICE 3', 'BR 403 Redesign' ],
+ '406' => [ 'ICE 3', 'BR 406' ],
+ '406.R' => [ 'ICE 3', 'BR 406 Redesign' ],
+ '407' => [ 'ICE 3 Velaro', 'BR 407' ],
+ '411.S1' => [ 'ICE T', 'BR 411, 1. Serie' ],
+ '411.S2' => [ 'ICE T', 'BR 411, 2. Serie' ],
+ '412' => ['ICE 4'],
+ '415' => [ 'ICE T', 'BR 415' ],
+ '475' => [ 'TGV', 'BR 475' ],
+ 'IC2.TWIN' => ['IC 2 Twindexx'],
+ 'IC2.KISS' => ['IC 2 KISS'],
+);
+
+my %power_desc = (
+ 90 => 'mit sonstigem Antrieb',
+ 91 => 'mit elektrischer Lokomotive',
+ 92 => 'mit Diesellokomotive',
+ 93 => 'Hochgeschwindigkeitszug',
+ 94 => 'Elektrischer Triebzug',
+ 95 => 'Diesel-Triebzug',
+ 96 => 'mit speziellen Beiwagen',
+ 97 => 'mit elektrischer Rangierlok',
+ 98 => 'mit Diesel-Rangierlok',
+ 99 => 'Sonderfahrzeug',
+);
+
sub new {
my ( $class, %opt ) = @_;
@@ -298,6 +357,46 @@ sub train_powertype {
return $self->{train_powertype} = $likelihood[0];
}
+sub train_desc {
+ my ($self) = @_;
+
+ my $powertype = $self->train_powertype;
+ my @model = $self->train_model;
+
+ my $ret = q{};
+
+ if (@model) {
+ $ret .= $model[0];
+ }
+
+ if ( $powertype and $power_desc{$powertype} ) {
+ if ( not $ret and $power_desc{$powertype} =~ m{^mit} ) {
+ $ret = "Zug";
+ }
+ $ret .= " $power_desc{$powertype}";
+ }
+
+ if ( @model > 1 ) {
+ $ret .= " ($model[1])";
+ }
+
+ return $ret;
+}
+
+sub train_model {
+ my ($self) = @_;
+
+ my $subtype = $self->train_subtype;
+
+ if ( $subtype and $model_name{$subtype} ) {
+ return @{ $model_name{$subtype} };
+ }
+ if ($subtype) {
+ return $subtype;
+ }
+ return;
+}
+
sub train_subtype {
my ($self) = @_;
@@ -305,75 +404,78 @@ sub train_subtype {
return $self->{train_subtype};
}
- my @wagons = $self->wagons;
- my $with_restaurant = 0;
+ my @wagons = $self->wagons;
my %ml = (
- 'ICE 1' => 0,
- 'ICE 2' => 0,
- 'ICE 3 403.1' => 0,
- 'ICE 3 403.2' => 0,
- 'ICE 3 406' => 0,
- 'ICE 3 Velaro' => 0,
- 'ICE 4' => 0,
- 'ICE T 411.1' => 0,
- 'ICE T 411.2' => 0,
- 'ICE T 415' => 0,
- 'IC2 Twindexx' => 0,
- 'IC2 KISS' => 0,
+ '401' => 0,
+ '402' => 0,
+ '403.S1' => 0,
+ '403.S2' => 0,
+ '403.R' => 0,
+ '406' => 0,
+ '407' => 0,
+ '411.S1' => 0,
+ '411.S2' => 0,
+ '412' => 0,
+ '415' => 0,
+ '475' => 0,
+ 'IC2.TWIN' => 0,
+ 'IC2.KISS' => 0,
);
for my $wagon (@wagons) {
if ( not $wagon->model ) {
next;
}
- if ( $wagon->type eq 'WRmz' ) {
- $with_restaurant = 1;
- }
if ( $wagon->model == 401
or ( $wagon->model >= 801 and $wagon->model <= 804 ) )
{
- $ml{'ICE 1'}++;
+ $ml{'401'}++;
}
elsif ( $wagon->model == 402
or ( $wagon->model >= 805 and $wagon->model <= 808 ) )
{
- $ml{'ICE 2'}++;
+ $ml{'402'}++;
+ }
+ elsif ( $wagon->model == 403
+ and $is_redesign{ substr( $wagon->uic_id, 9, 2 ) } )
+ {
+ $ml{'403.R'}++;
}
elsif ( $wagon->model == 403 and substr( $wagon->uic_id, 9, 2 ) <= 37 )
{
- $ml{'ICE 3 403.1'}++;
+ $ml{'403.S1'}++;
}
elsif ( $wagon->model == 403 and substr( $wagon->uic_id, 9, 2 ) > 37 ) {
- $ml{'ICE 3 403.2'}++;
+ $ml{'403.S2'}++;
}
elsif ( $wagon->model == 406 ) {
- $ml{'ICE 3 406'}++;
+ $ml{'406'}++;
}
elsif ( $wagon->model == 407 ) {
- $ml{'ICE 3 Velaro'}++;
+ $ml{'407'}++;
}
elsif ( $wagon->model == 412 or $wagon->model == 812 ) {
- $ml{'ICE 4'}++;
+ $ml{'412'}++;
}
elsif ( $wagon->model == 411 and substr( $wagon->uic_id, 9, 2 ) <= 32 )
{
- $ml{'ICE T 411.1'}++;
+ $ml{'411.S1'}++;
}
elsif ( $wagon->model == 411 and substr( $wagon->uic_id, 9, 2 ) > 32 ) {
- $ml{'ICE T 411.2'}++;
+ $ml{'411.S2'}++;
}
elsif ( $wagon->model == 415 ) {
- $ml{'ICE T 415'}++;
+ $ml{'415'}++;
}
elsif ( $wagon->model == 475 ) {
- $ml{'TGV'}++;
+ $ml{'475'}++;
}
elsif ( $self->train_type eq 'IC' and $wagon->model == 110 ) {
- $ml{'IC2 KISS'}++;
+ $ml{'IC2.KISS'}++;
}
elsif ( $self->train_type eq 'IC' and $wagon->is_dosto ) {
- $ml{'IC2 Twindexx'}++;
+ $ml{'IC2.TWIN'}++;
}
}
@@ -387,9 +489,6 @@ sub train_subtype {
$self->{train_subtype} = $likelihood[0];
- if ( $self->{train_subtype} =~ m{ICE 3 4} and $with_restaurant ) {
- $self->{train_subtype} = 'ICE 3 Redesign';
- }
return $self->{train_subtype};
}
@@ -601,6 +700,17 @@ Returns the name of the requested station.
Returns the international id (UIC ID / IBNR) of the requested station.
+=item $wr->train_desc
+
+Returns a string describing the rolling stock used for this train based on
+model and locomotive (if present), e.g. "ICE 4 Hochgeschwindigkeitszug",
+"IC 2 Twindexx mit elektrischer Lokomotive", or "Diesel-Triebzug".
+
+=item $wr->train_model
+
+Returns a string describing the rolling stock used for this train, e.g. "ICE 4"
+or "IC2 KISS".
+
=item $wr->train_numbers
Returns the list of train numbers for this departure. In most cases, this is
@@ -613,8 +723,8 @@ Returns a string describing the train type, e.g. "ICE" or "IC".
=item $wr->train_subtype
-Returns a string describing the rolling stock used for this train, e.g. "ICE 4"
-or "IC2 KISS".
+Returns a string describing the rolling stock model used for this train, e.g.
+"412" (model 412 aka ICE 4) or "411.S2" (model 411 aka ICE T, series 2).
=item $wr->wagons