Port to new bahn.de API

}

my $wr = Travel::Status::DE::DBWagenreihung->new(

	departure      => $trains[0]->sched_departure || $trains[0]->sched_arrival,

	developer_mode => $developer_mode,

	departure      => $trains[0]->sched_departure || $trains[0]->sched_arrival,

	eva            => $trains[0]->station_eva,

	train_type     => $trains[0]->type,

	train_number   => $train_number,

);

if ( $wr->errstr ) {

	say STDERR $wr->errstr;

	exit 2;

}

printf(

	"%s: %s → %s\n",

	join( ' / ', map { $wr->train_type . ' ' . $_ } $wr->train_numbers ),

	"%s → %s\n",

	join(

		' / ',

		map {

			sprintf( '%s (%s)', $_->{name}, join( q{}, @{ $_->{sections} } ) )

		} $wr->origins

		' / ', map { $wr->train_type . ' ' . $_->{name} } $wr->train_numbers

	),

	join(

		' / ',

		map {

			sprintf( '%s (%s)', $_->{name}, join( q{}, @{ $_->{sections} } ) )

			sprintf( '%s (%s)', $_->{name}, join( q{}, @{ $_->{sectors} } ) )

		} $wr->destinations

	),

);

printf( "%s Gleis %s\n\n", $wr->station->{name}, $wr->platform );

printf( "Gleis %s\n\n", $wr->platform );

for my $section ( $wr->sections ) {

	my $section_length = $section->length_percent;

	my $spacing_left   = int( ( $section_length - 2 ) / 2 ) - 1;

	my $spacing_right  = int( ( $section_length - 2 ) / 2 );

for my $sector ( $wr->sectors ) {

	my $sector_length = $sector->length_percent;

	my $spacing_left  = int( ( $sector_length - 2 ) / 2 ) - 1;

	my $spacing_right = int( ( $sector_length - 2 ) / 2 );

	if ( $section_length % 2 ) {

	if ( $sector_length % 2 ) {

		$spacing_left++;

	}

	printf( "▏%s%s%s▕",

		( $spacing_left >= 0 )                  ? ' ' x $spacing_left  : q{},

		$section->name, ( $spacing_right >= 0 ) ? ' ' x $spacing_right : q{} );

		( $spacing_left >= 0 )                 ? ' ' x $spacing_left  : q{},

		$sector->name, ( $spacing_right >= 0 ) ? ' ' x $spacing_right : q{} );

}

print "\n";

my @start_percentages = map { $_->{position}{start_percent} } $wr->wagons;

my @start_percentages = map { $_->start_percent } $wr->carriages;

if ( my $min_percentage = min @start_percentages ) {

	print ' ' x ( $min_percentage - 1 );

}

print $wr->direction == 100 ? '>' : '<';

for my $wagon ( $wr->wagons ) {

	my $wagon_length

	  = $wagon->{position}->{end_percent} - $wagon->{position}->{start_percent};

for my $wagon ( $wr->carriages ) {

	my $wagon_length  = $wagon->length_percent;

	my $spacing_left  = int( $wagon_length / 2 ) - 2;

	my $spacing_right = int( $wagon_length / 2 ) - 1;

print "\n\n";

for my $group ( $wr->groups ) {

	if ( $group->has_sections ) {

	if ( $group->has_sectors ) {

		printf( "%s (%s)\n",

			$group->description || 'Zug',

			join( q{}, $group->sections ) );

			join( q{}, $group->sectors ) );

	}

	else {

		say $group->description || 'Zug';

	}

	printf(

		"%s %s  %s → %s\n\n",

		$wr->train_type, $group->train_no,

		$group->origin,  $group->destination

	);

	printf( "%s %s  → %s\n\n",

		$wr->train_type, $group->train_no, $group->destination );

	for my $wagon ( $group->wagons ) {

	for my $wagon ( $group->carriages ) {

		printf(

			"%3s: %3s %10s  %s\n",

			$wagon->is_closed       ? 'X'

package Travel::Status::DE::DBWagenreihung::Wagon;

package Travel::Status::DE::DBWagenreihung::Carriage;

use strict;

use warnings;

use Carp qw(cluck);

our $VERSION = '0.14';

Travel::Status::DE::DBWagenreihung::Wagon->mk_ro_accessors(

	qw(attributes class_type group_index has_ac has_accessibility

	  has_bahn_comfort has_bike_storage has_bistro has_compartments

	  has_family_area has_phone_area has_quiet_area is_closed is_dosto

	  is_interregio is_locomotive is_powercar number model multipurpose section

	  train_no train_subtype type uic_id)

);

our %type_attributes = (

	'ICE 1' => [

		undef, ['has_quiet_area'],  undef, ['has_quiet_area'],     # 1 2 3 4

		['has_family_area'], undef, ['has_bahn_comfort'],          # 5 6 7

		undef,               undef, undef, ['has_bahn_comfort'],   # 8 9 (10) 11

		['has_quiet_area'],  undef, undef                          # 12 (13) 14

	],

	'ICE 2' => [

		undef, ['has_quiet_area'], ['has_bahn_comfort'],

		['has_family_area'],                                       # 1 2 3 4

		undef, ['has_bahn_comfort'],

		[ 'has_quiet_area', 'has_phone_area' ]                     # 5 6 7

	],

	'ICE 3' => [

		['has_quiet_area'],  undef, undef, undef,                  # 1 2 3 (4)

		['has_family_area'], undef, ['has_bahn_comfort'],          # 5 6 7

		[ 'has_quiet_area', 'has_phone_area', 'has_bahn_comfort' ], undef  # 8 9

	],

	'ICE 3 Velaro' => [

		['has_quiet_area'],   undef, undef, ['has_family_area'],    # 1 2 3 4

		['has_bahn_comfort'], ['has_bahn_comfort'], undef, undef,    # 5 6 (7) 8

		[ 'has_quiet_area', 'has_phone_area' ]                       # 9

	],

	'ICE 4' => [

		['has_bike_storage'], undef, ['has_quiet_area'], undef,

		undef,                                                       # 1 2 3 4 5

		undef, ['has_bahn_comfort'], undef, ['has_family_area'],     # 6 7 (8) 9

		undef, ['has_bahn_comfort'], undef, undef,

		['has_quiet_area']    # 10 11 12 (13) 14

	],

	'ICE T 411' => [

		['has_quiet_area'], ['has_quiet_area'], undef,

		['has_family_area'],                        # 1 2 3 4

		undef, undef, ['has_bahn_comfort'],

		[ 'has_quiet_area', 'has_bahn_comfort' ]    # (5) 6 7 8

	],

	'ICE T 415' => [

		['has_quiet_area'], ['has_quiet_area'], ['has_bahn_comfort'],

		undef,                                      # 1 2 3 (4)

		undef, undef, ['has_family_area'],

		[ 'has_quiet_area', 'has_bahn_comfort' ]    # (5) (6) 7 8

	],

	'IC2 Twindexx' => [

		[ 'has_family_area', 'has_bike_storage' ], ['has_bike_storage'],   # 1 2

		['has_bike_storage'], [ 'has_bike_storage', 'has_bahn_comfort' ],  # 3 4

		[ 'has_bahn_comfort', 'has_quiet_area', 'has_phone_area' ]         # 5

	],

Travel::Status::DE::DBWagenreihung::Carriage->mk_ro_accessors(

	qw(class_type is_closed is_dosto is_locomotive is_powercar

	  number model section uic_id type

	  start_meters end_meters length_meters start_percent end_percent length_percent

	)

);

sub new {

	my ( $obj, %opt ) = @_;

	my $ref = {};

	my %json     = %{ $opt{json} };

	my $platform = $opt{platform};

	$ref->{class_type}    = 0;

	$ref->{has_bistro}    = 0;

	$ref->{is_locomotive} = 0;

	$ref->{is_powercar}   = 0;

	$ref->{is_closed}     = 0;

	$ref->{train_no}      = $opt{train_no};

	$ref->{number}        = $opt{wagenordnungsnummer};

	$ref->{model}         = $opt{fahrzeugnummer};

	$ref->{uic_id}        = $opt{fahrzeugnummer};

	$ref->{section}       = $opt{fahrzeugsektor};

	$ref->{type}          = $opt{fahrzeugtyp};

	$ref->{number}        = $json{wagonIdentificationNumber};

	$ref->{model}         = $json{vehicleID};

	$ref->{uic_id}        = $json{vehicleID};

	$ref->{section}       = $json{platformPosition}{sector};

	$ref->{type}          = $json{type}{constructionType};

	$ref->{model} =~ s{^.....(...)....$}{$1} or $ref->{model} = undef;

	$ref->{model} =~ s{^.....(...)....(?:-.)?$}{$1} or $ref->{model} = undef;

	my $self = bless( $ref, $obj );

	$self->parse_type;

	if ( $opt{status} and $opt{status} eq 'GESCHLOSSEN' ) {

	if ( $json{status} and $json{status} eq 'CLOSED' ) {

		$ref->{is_closed} = 1;

	}

	if ( $opt{kategorie} =~ m{SPEISEWAGEN} ) {

	if ( $json{type}{category} =~ m{DININGCAR} ) {

		$ref->{has_bistro} = 1;

	}

	elsif ( $opt{kategorie} eq 'LOK' ) {

	elsif ( $json{type}{category} eq 'LOCOMOTIVE' ) {

		$ref->{is_locomotive} = 1;

	}

	elsif ( $opt{kategorie} eq 'TRIEBKOPF' ) {

	elsif ( $json{type}{category} eq 'POWERCAR' ) {

		$ref->{is_powercar} = 1;

	}

	if ( $opt{fahrzeugtyp} =~ m{AB} ) {

	if ( $ref->{type} =~ m{AB} ) {

		$ref->{class_type} = 12;

	}

	elsif ( $opt{fahrzeugtyp} =~ m{A} ) {

	elsif ( $ref->{type} =~ m{A} ) {

		$ref->{class_type} = 1;

	}

	elsif ( $opt{fahrzeugtyp} =~ m{B|WR} ) {

	elsif ( $ref->{type} =~ m{B|WR} ) {

		$ref->{class_type} = 2;

	}

	my $pos = $opt{positionamhalt};

	my $pos             = $json{platformPosition};

	my $platform_length = $platform->{end} - $platform->{start};

	$ref->{position}{start_percent} = $pos->{startprozent};

	$ref->{position}{end_percent}   = $pos->{endeprozent};

	$ref->{position}{start_meters}  = $pos->{startmeter};

	$ref->{position}{end_meters}    = $pos->{endemeter};

	$ref->{start_meters} = $pos->{start};

	$ref->{end_meters}   = $pos->{end};

	$ref->{start_percent}

	  = ( $pos->{start} - $platform->{start} ) * 100 / $platform_length,

	  $ref->{end_percent}

	  = ( $pos->{end} - $platform->{start} ) * 100 / $platform_length,

	  $ref->{length_meters} = $pos->{start} - $pos->{end};

	$ref->{length_percent} = $ref->{end_percent} - $ref->{start_percent};

	if (   $pos->{startprozent} eq ''

		or $pos->{endeprozent} eq ''

		or $pos->{startmeter} eq ''

		or $pos->{endemeter} eq '' )

	if (   $pos->{start} eq ''

		or $pos->{end} eq '' )

	{

		$ref->{position}{valid} = 0;

	}

	}

	if ( $type =~ m{i} ) {

		$self->{is_interregio} = 1;

		push( @desc, 'Interregio' );

	}

	$self->{attributes} = \@desc;

}

sub set_traintype {

	my ( $self, $group_index, $tt ) = @_;

	$self->{group_index} = $group_index;

	if ( not $tt ) {

		return;

	}

	$self->{train_subtype} = $tt;

	if ( not $self->{number} or not exists( $type_attributes{$tt} ) ) {

		return;

	}

	if ( $self->{number} !~ m{^\d+$} ) {

		return;

	}

	my $index = $self->{number} - 1;

	if ( $index >= 30 ) {

		$index -= 30;

	}

	elsif ( $index >= 20 ) {

		$index -= 20;

	}

	if ( not $type_attributes{$tt}[$index] ) {

		return;

	}

	for my $attr ( @{ $type_attributes{$tt}[$index] } ) {

		$self->{$attr} = 1;

	}

}

sub is_first_class {

	my ($self) = @_;

use utf8;

use parent 'Class::Accessor';

use List::Util qw(uniq);

our $VERSION = '0.14';

Travel::Status::DE::DBWagenreihung::Group->mk_ro_accessors(

	qw(id train_no type description desc_short origin destination has_sections)

	qw(train_no train_type description desc_short destination has_sectors model series)

);

# {{{ Rolling Stock Models

my %model_name = (

	'011'      => [ 'ICE T', 'ÖBB 4011' ],

	'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' ],

	'408'      => [ 'ICE 3neo',     'BR 408' ],

	'411.S1'   => [ 'ICE T',        'BR 411, 1. Serie' ],

	'411.S2'   => [ 'ICE T',        'BR 411, 2. Serie' ],

	'412'      => ['ICE 4'],

	'415'      => [ 'ICE T', 'BR 415' ],

	'420'      => ['BR 420'],

	'422'      => ['BR 422'],

	'423'      => ['BR 423'],

	'425'      => ['BR 425'],

	'427'      => [ 'FLIRT', 'BR 427' ],

	'428'      => [ 'FLIRT', 'BR 428' ],

	'429'      => [ 'FLIRT', 'BR 429' ],

	'430'      => ['BR 430'],

	'440'      => [ 'Coradia Continental', 'BR 440' ],

	'442'      => [ 'Talent 2',            'BR 442' ],

	'445'      => [ 'Twindexx Vario',      'BR 445' ],

	'446'      => [ 'Twindexx Vario',      'BR 446' ],

	'462'      => [ 'Desiro HC',           'BR 462' ],

	'463'      => [ 'Mireo',               'BR 463' ],

	'475'      => [ 'TGV',                 'BR 475' ],

	'612'      => [ 'RegioSwinger',        'BR 612' ],

	'620'      => [ 'LINT 81',             'BR 620' ],

	'622'      => [ 'LINT 54',             'BR 622' ],

	'631'      => [ 'Link I',              'BR 631' ],

	'632'      => [ 'Link II',             'BR 632' ],

	'633'      => [ 'Link III',            'BR 633' ],

	'640'      => [ 'LINT 27',             'BR 640' ],

	'642'      => [ 'Desiro Classic',      'BR 642' ],

	'643'      => [ 'TALENT',              'BR 643' ],

	'648'      => [ 'LINT 41',             'BR 648' ],

	'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 ( $obj, %opt ) = @_;

	my $ref = \%opt;

	return bless( $ref, $obj );

}

	my %json = %{ $opt{json} };

sub set_description {

	my ( $self, $desc, $short ) = @_;

	my $ref = {

		carriages   => $opt{carriages},

		destination => $json{transport}{destination}{name},

		train_type  => $json{transport}{category},

		name        => $json{transport}{name},

		line        => $json{transport}{numberwline},

		train_no    => $json{transport}{number},

	};

	$self->{description} = $desc;

	$self->{desc_short}  = $short;

	$ref->{sectors} = [

		uniq grep { defined }

		  map     { $_->{platformPosition}{sector} } @{ $json{vehicles} // [] }

	];

	if ( @{ $ref->{sectors} } ) {

		$ref->{has_sectors} = 1;

	}

	bless( $ref, $obj );

	$ref->parse_description;

	return $ref;

}

sub set_sections {

	my ( $self, @sections ) = @_;

sub parse_powertype {

	my ($self) = @_;

	my %ml = map { $_ => 0 } ( 90 .. 99 );

	for my $carriage ( $self->carriages ) {

		if ( not $carriage->uic_id or length( $carriage->uic_id ) != 12 ) {

			next;

		}

		my $carriage_type = substr( $carriage->uic_id, 0, 2 );

		if ( $carriage_type < 90 ) {

			next;

		}

		$ml{$carriage_type}++;

	}

	my @likelihood = reverse sort { $ml{$a} <=> $ml{$b} } keys %ml;

	$self->{sections} = [@sections];

	if ( $ml{ $likelihood[0] } == 0 ) {

		return;

	}

	$self->{has_sections} = 1;

	$self->{powertype} = $likelihood[0];

}

sub set_traintype {

	my ( $self, $i, $tt ) = @_;

	$self->{type} = $tt;

	for my $wagon ( $self->wagons ) {

		$wagon->set_traintype( $i, $tt );

sub parse_model {

	my ($self) = @_;

	my %ml = (

		'011'      => 0,

		'401'      => 0,

		'402'      => 0,

		'403.S1'   => 0,

		'403.S2'   => 0,

		'403.R'    => 0,

		'406'      => 0,

		'407'      => 0,

		'408'      => 0,

		'411.S1'   => 0,

		'411.S2'   => 0,

		'412'      => 0,

		'415'      => 0,

		'420'      => 0,

		'422'      => 0,

		'423'      => 0,

		'425'      => 0,

		'427'      => 0,

		'428'      => 0,

		'429'      => 0,

		'430'      => 0,

		'440'      => 0,

		'442'      => 0,

		'445'      => 0,

		'446'      => 0,

		'462'      => 0,

		'463'      => 0,

		'475'      => 0,

		'612'      => 0,

		'620'      => 0,

		'622'      => 0,

		'631'      => 0,

		'632'      => 0,

		'633'      => 0,

		'640'      => 0,

		'642'      => 0,

		'643'      => 0,

		'648'      => 0,

		'IC2.TWIN' => 0,

		'IC2.KISS' => 0,

	);

	my @carriages = $self->carriages;

	for my $carriage (@carriages) {

		if ( not $carriage->model ) {

			next;

		}

		if ( $carriage->model == 401

			or ( $carriage->model >= 801 and $carriage->model <= 804 ) )

		{

			$ml{'401'}++;

		}

		elsif ( $carriage->model == 402

			or ( $carriage->model >= 805 and $carriage->model <= 808 ) )

		{

			$ml{'402'}++;

		}

		elsif ( $carriage->model == 403

			and substr( $carriage->uic_id, 9, 2 ) <= 37 )

		{

			$ml{'403.S1'}++;

		}

		elsif ( $carriage->model == 403

			and substr( $carriage->uic_id, 9, 2 ) > 37 )

		{

			$ml{'403.S2'}++;

		}

		elsif ( $carriage->model == 406 ) {

			$ml{'406'}++;

		}

		elsif ( $carriage->model == 407 ) {

			$ml{'407'}++;

		}

		elsif ( $carriage->model == 408 ) {

			$ml{'408'}++;

		}

		elsif ( $carriage->model == 412 or $carriage->model == 812 ) {

			$ml{'412'}++;

		}

		elsif ( $carriage->model == 411

			and substr( $carriage->uic_id, 9, 2 ) <= 32 )

		{

			$ml{'411.S1'}++;

		}

		elsif ( $carriage->model == 411

			and substr( $carriage->uic_id, 9, 2 ) > 32 )

		{

			$ml{'411.S2'}++;

		}

		elsif ( $carriage->model == 415 ) {

			$ml{'415'}++;

		}

		elsif ( $carriage->model == 420 or $carriage->model == 421 ) {

			$ml{'420'}++;

		}

		elsif ( $carriage->model == 422 or $carriage->model == 432 ) {

			$ml{'422'}++;

		}

		elsif ( $carriage->model == 423 or $carriage->model == 433 ) {