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

Port to new bahn.de API

parent fc59bcac

bin/db-wagenreihung

+27 −28
Original line number Diff line number Diff line
@@ -65,54 +65,56 @@ if ( @trains != 1 ) { 
}



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{} );

		$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;
@@ -149,21 +151,18 @@ print $wr->direction == 100 ? '>' : '<'; 
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'

lib/Travel/Status/DE/DBWagenreihung.pm

+109 −593

File changed.

Preview size limit exceeded, changes collapsed.

lib/Travel/Status/DE/DBWagenreihung/Wagon.pm→lib/Travel/Status/DE/DBWagenreihung/Carriage.pm

+189 −0
Original line number Diff line number Diff line 
package Travel::Status::DE::DBWagenreihung::Wagon;

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



use strict;

use warnings;
@@ -9,120 +9,75 @@ use parent 'Class::Accessor'; 
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;

	}
@@ -168,7 +123,6 @@ sub parse_type { 
	}



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

		$self->{is_interregio} = 1;

		push( @desc, 'Interregio' );

	}
@@ -200,43 +154,6 @@ sub parse_type { 
	$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) = @_;

lib/Travel/Status/DE/DBWagenreihung/Group.pm

+354 −25
Original line number Diff line number Diff line
@@ -6,61 +6,390 @@ use 5.020; 
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} };



	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},

	};



	$ref->{sectors} = [

		uniq grep { defined }

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

	];

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

		$ref->{has_sectors} = 1;

	}



sub set_description {

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

	bless( $ref, $obj );



	$self->{description} = $desc;

	$self->{desc_short}  = $short;

	$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;



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

		return;

	}



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

}



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 ) {

			$ml{'423'}++;

		}

		elsif ( $carriage->model == 425 or $carriage->model == 435 ) {

			$ml{'425'}++;

		}

		elsif ( $carriage->model == 427 or $carriage->model == 827 ) {

			$ml{'427'}++;

		}

		elsif ( $carriage->model == 428 or $carriage->model == 828 ) {

			$ml{'428'}++;

		}

		elsif ( $carriage->model == 429 or $carriage->model == 829 ) {

			$ml{'429'}++;

		}

		elsif ( $carriage->model == 430 or $carriage->model == 431 ) {

			$ml{'430'}++;

		}

		elsif ($carriage->model == 440

			or $carriage->model == 441

			or $carriage->model == 841 )

		{

			$ml{'440'}++;

		}

		elsif ($carriage->model == 442

			or $carriage->model == 443 )

		{

			$ml{'442'}++;

		}

		elsif ($carriage->model == 462

			or $carriage->model == 862 )

		{

			$ml{'462'}++;

		}

		elsif ($carriage->model == 463

			or $carriage->model == 863 )

		{

			$ml{'463'}++;

		}

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

			$ml{'445'}++;

		}

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

			$ml{'446'}++;

		}

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

			$ml{'475'}++;

		}

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

			$ml{'612'}++;

		}

		elsif ( $carriage->model == 620 or $carriage->model == 621 ) {

			$ml{'620'}++;

		}

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

			$ml{'622'}++;

		}

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

			$ml{'631'}++;

		}

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

			$ml{'632'}++;

		}

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

			$ml{'633'}++;

		}

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

			$ml{'640'}++;

		}

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

			$ml{'642'}++;

		}

		elsif ( $carriage->model == 643 or $carriage->model == 943 ) {

			$ml{'643'}++;

		}

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

			$ml{'648'}++;

		}

		elsif ( $self->train_type eq 'IC' and $carriage->model == 110 ) {

			$ml{'IC2.KISS'}++;

		}

		elsif ( $self->train_type eq 'IC' and $carriage->is_dosto ) {

			$ml{'IC2.TWIN'}++;

		}

		elsif ( substr( $carriage->uic_id, 4, 4 ) eq '4011' ) {

			$ml{'011'}++;

		}

	}



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

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



	$self->{has_sections} = 1;

	# Less than two carriages are generally inconclusive.

	# Exception: BR 631 (Link I) only has a single carriage

	if (

		$ml{ $likelihood[0] } < 2

		and not($likelihood[0] eq '631'

			and @carriages == 1

			and substr( $carriages[0]->uic_id, 0, 2 ) eq '95' )

	  )

	{

		$self->{subtype} = undef;

	}

	else {

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

	}



sub set_traintype {

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

	$self->{type} = $tt;

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

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

	if ( $self->{subtype} and $model_name{ $self->{subtype} } ) {

		my @model = @{ $model_name{ $self->{subtype} } };

		$self->{model}  = $model[0];

		$self->{series} = $model[-1];

	}

}



sub sort_wagons {

sub parse_description {

	my ($self) = @_;



	@{ $self->{wagons} }

	  = sort { $a->{position}{start_percent} <=> $b->{position}{start_percent} }

	  @{ $self->{wagons} };

	$self->parse_powertype;

	$self->parse_model;



	my $short;

	my $ret = q{};



	if ( $self->{model} ) {

		$short = $self->{model};

		$ret .= $self->{model};

	}



	if ( $self->{powertype} and $power_desc{ $self->{powertype} } ) {

		if ( not $ret and $power_desc{ $self->{powertype} } =~ m{^mit} ) {

			$ret = "Zug";

		}

		$ret .= ' ' . $power_desc{ $self->{powertype} };

		$short //= $ret;

		$short =~ s{elektrischer }{E-};

		$short =~ s{[Ll]\Kokomotive}{ok};

	}



	if ( $self->{series} and $self->{series} ne $self->{model} ) {

		$ret .= ' (' . $self->{series} . ')';

	}



	$self->{desc_short}  = $short;

	$self->{description} = $ret;

}



sub sections {

sub sectors {

	my ($self) = @_;



	return @{ $self->{sections} // [] };

	return @{ $self->{sectors} // [] };

}



sub wagons {

sub carriages {

	my ($self) = @_;



	return @{ $self->{wagons} // [] };

	return @{ $self->{carriages} // [] };

}



sub TO_JSON {

lib/Travel/Status/DE/DBWagenreihung/Section.pm→lib/Travel/Status/DE/DBWagenreihung/Sector.pm

+51 −0
Original line number Diff line number Diff line 
package Travel::Status::DE::DBWagenreihung::Section;

package Travel::Status::DE::DBWagenreihung::Sector;



use strict;

use warnings;
@@ -9,15 +9,32 @@ use parent 'Class::Accessor'; 


our $VERSION = '0.14';



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

	qw(name start_percent end_percent length_percent start_meters end_meters length_meters)

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

	qw(name start_percent end_percent length_percent start_meters end_meters length_meters cube_meters cube_percent)

);



sub new {

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

	my $ref = \%opt;



	$ref->{length_meters}  = $ref->{end_meters} - $ref->{start_meters};

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

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



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



	my $ref = {

		name          => $section{name},

		start_meters  => $section{start},

		end_meters    => $section{end},

		length_meters => $section{end} - $section{start},

		cube_meters   => $section{cubePosition},

		start_percent => ( $section{start} - $platform{start} )

		  * 100 / $platform_length,

		end_percent => ( $section{end} - $platform{start} )

		  * 100 / $platform_length,

		cube_percent => ( $section{cubePosition} - $platform{start} )

		  * 100 / $platform_length,

	};



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



	return bless( $ref, $obj );