merge DBWagenreihung modules into DBRIS; they both use bahn.de (a5b392d6) · Commits · derf / Travel-Status-DE-DBRIS

bin/dbris-m

+114 −1

Original line number	Diff line number	Diff line
		@@ -10,7 +10,7 @@ use DateTime;
		use Encode qw(decode);
		use JSON;
		use Getopt::Long qw(:config no_ignore_case);
		use List::Util qw(max);
		use List::Util qw(min max);
		use Travel::Status::DE::DBRIS;

		my ( $date, $time );
		@@ -32,6 +32,11 @@ for my $arg (@ARGV) {
		my $output_bold = -t STDOUT ? "\033[1m" : q{};
		my $output_reset = -t STDOUT ? "\033[0m" : q{};

		my $cf_first = "\e[38;5;11m";
		my $cf_mixed = "\e[38;5;208m";
		my $cf_second = "\e[0m"; #"\e[38;5;9m";
		my $cf_reset = "\e[0m";

		GetOptions(
		'd\|date=s' => \$date,
		'h\|help' => sub { show_help(0) },
		@@ -430,6 +435,114 @@ elsif ( $opt{locationSearch} ) {
		}
		}

		if ($train_no) {
		$status = Travel::Status::DE::DBRIS->new(
		cache => $cache,
		developer_mode => $developer_mode,
		formation => $train_no
		);

		my $wr = $status->result;

		printf(
		"\n%s → %s\n",
		join( ' / ',
		map { $wr->train_type . ' ' . $_->{name} } $wr->train_numbers ),
		join(
		' / ',
		map {
		sprintf( '%s (%s)',
		$_->{name}, join( q{}, @{ $_->{sectors} } ) )
		} $wr->destinations
		),
		);

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

		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 ( $sector_length % 2 ) {
		$spacing_left++;
		}

		printf( "▏%s%s%s▕",
		( $spacing_left >= 0 ) ? ' ' x $spacing_left : q{},
		$sector->name,
		( $spacing_right >= 0 ) ? ' ' x $spacing_right : q{} );
		}
		print "\n";

		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->carriages ) {
		my $wagon_length = $wagon->length_percent;
		my $spacing_left = int( $wagon_length / 2 ) - 2;
		my $spacing_right = int( $wagon_length / 2 ) - 1;

		if ( $wagon_length % 2 ) {
		$spacing_left++;
		}

		my $wagon_desc = $wagon->number \|\| '?';

		if ( $wagon->is_closed ) {
		$wagon_desc = 'X';
		}

		if ( $wagon->is_locomotive or $wagon->is_powercar ) {
		$wagon_desc = ' ■ ';
		}

		my $class_color = '';
		if ( $wagon->class_type == 1 ) {
		$class_color = $cf_first;
		}
		elsif ( $wagon->class_type == 2 ) {
		$class_color = $cf_second;
		}
		elsif ( $wagon->class_type == 12 ) {
		$class_color = $cf_mixed;
		}

		printf( "%s%s%3s%s%s",
		' ' x $spacing_left, $class_color, $wagon_desc,
		$cf_reset, ' ' x $spacing_right );
		}
		print $wr->direction == 100 ? '>' : '<';
		print "\n\n";

		for my $group ( $wr->groups ) {
		printf( "%s%s%s\n",
		$group->description \|\| 'Zug',
		$group->designation ? ' „' . $group->designation . '“' : q{},
		$group->has_sectors
		? ' (' . join( q{}, $group->sectors ) . ')'
		: q{} );
		printf( "%s %s → %s\n\n",
		$group->train_type, $group->train_no, $group->destination );

		for my $wagon ( $group->carriages ) {
		printf(
		"%3s: %3s %10s %s\n",
		$wagon->is_closed ? 'X'
		: $wagon->is_locomotive ? 'Lok'
		: $wagon->number \|\| '?',
		$wagon->model \|\| '???',
		$wagon->type,
		join( q{ }, $wagon->attributes )
		);
		}
		say "";
		}
		}

		__END__

		=head1 NAME

lib/Travel/Status/DE/DBRIS.pm

+30 −0

Original line number	Diff line number	Diff line
		@@ -13,6 +13,8 @@ use DateTime::Format::Strptime;
		use Encode qw(decode encode);
		use JSON;
		use LWP::UserAgent;

		use Travel::Status::DE::DBRIS::Formation;
		use Travel::Status::DE::DBRIS::JourneyAtStop;
		use Travel::Status::DE::DBRIS::Journey;
		use Travel::Status::DE::DBRIS::Location;
		@@ -87,6 +89,22 @@ sub new {
		$req
		= "https://www.bahn.de/web/api/reiseloesung/fahrt?journeyId=${journey_id}&poly=${poly}";
		}
		elsif ( my $cf = $conf{formation} ) {
		my $datetime = $cf->{departure}->clone->set_time_zone('UTC');
		my $date = $datetime->strftime('%Y-%m-%d');
		my $time = $datetime->rfc3339 =~ s{(?=Z)}{.000}r;
		my %param = (
		administrationId => 80,
		category => $cf->{train_type},
		date => $date,
		evaNumber => $cf->{eva},
		number => $cf->{train_number},
		time => $time
		);
		$req
		= 'https://www.bahn.de/web/api/reisebegleitung/wagenreihung/vehicle-sequence?'
		. join( '&', map { $_ . '=' . $param{$_} } sort keys %param );
		}
		else {
		confess(
		'station / geoSearch / locationSearch / journey must be specified'
		@@ -141,6 +159,9 @@ sub new {
		elsif ( $conf{geoSearch} or $conf{locationSearch} ) {
		$self->parse_search;
		}
		elsif ( $conf{formation} ) {
		$self->parse_formation( $conf{formation} );
		}

		return $self;
		}
		@@ -310,6 +331,15 @@ sub parse_stationboard {
		return $self;
		}

		sub parse_formation {
		my ( $self, $conf ) = @_;

		$self->{result} = Travel::Status::DE::DBRIS::Formation->new(
		json => $self->{raw_json},
		train_type => $conf->{train_type}
		);
		}

		# }}}
		# {{{ Public Functions

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

0 → 100644

+175 −0

Original line number	Diff line number	Diff line
		package Travel::Status::DE::DBRIS::Formation;

		use strict;
		use warnings;
		use 5.020;

		use List::Util qw(uniq);

		use parent 'Class::Accessor';

		use Travel::Status::DE::DBRIS::Formation::Group;
		use Travel::Status::DE::DBRIS::Formation::Sector;
		use Travel::Status::DE::DBRIS::Formation::Carriage;

		our $VERSION = '0.01';

		Travel::Status::DE::DBRIS::Formation->mk_ro_accessors(
		qw(direction platform train_type));

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

		my $json = $opt{json};

		my $ref = {
		json => $opt{json},
		train_type => $opt{train_type},
		platform => $json->{departurePlatform},
		platform_sched => $json->{departurePlatformSchedule},
		};

		bless( $ref, $obj );

		$ref->parse_carriages;
		$ref->{destinations} = $ref->merge_group_attr('destination');
		$ref->{train_numbers} = $ref->merge_group_attr('train_no');
		$ref->{trains} = $ref->merge_group_attr('train');

		return $ref;
		}

		sub merge_group_attr {
		my ( $self, $attr ) = @_;

		my @attrs;
		my %attr_to_group;
		my %attr_to_sectors;

		for my $group ( $self->groups ) {
		push( @attrs, $group->{$attr} );
		push( @{ $attr_to_group{ $group->{$attr} } }, $group );
		push( @{ $attr_to_sectors{ $group->{$attr} } }, $group->sectors );
		}

		@attrs = uniq @attrs;

		return [
		map {
		{
		name => $_,
		groups => $attr_to_group{$_},
		sectors => $attr_to_sectors{$_}
		}
		} @attrs
		];
		}

		sub parse_carriages {
		my ($self) = @_;

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

		for my $sector ( @{ $self->{json}{platform}{sectors} } ) {
		push(
		@{ $self->{sectors} },
		Travel::Status::DE::DBRIS::Formation::Sector->new(
		json => $sector,
		platform => {
		start => $self->{json}{platform}{start},
		end => $self->{json}{platform}{end},
		}
		)
		);
		}

		my @groups;
		my @numbers;

		for my $group ( @{ $self->{json}{groups} // [] } ) {
		my @group_carriages;
		for my $carriage ( @{ $group->{vehicles} // [] } ) {
		my $carriage_object
		= Travel::Status::DE::DBRIS::Formation::Carriage->new(
		json => $carriage,
		platform => {
		start => $self->{json}{platform}{start},
		end => $self->{json}{platform}{end},
		}
		);
		push( @group_carriages, $carriage_object );
		push( @{ $self->{carriages} }, $carriage_object );
		}
		@group_carriages
		= sort { $a->start_percent <=> $b->start_percent } @group_carriages;
		my $group_obj = Travel::Status::DE::DBRIS::Formation::Group->new(
		json => $group,
		carriages => \@group_carriages,
		);
		push( @groups, $group_obj );
		push( @numbers, $group_obj->train_no );
		}

		@groups = sort { $a->start_percent <=> $b->start_percent } @groups;

		@numbers = uniq @numbers;
		$self->{train_numbers} = \@numbers;

		if ( @{ $self->{carriages} // [] } > 1 ) {
		if ( $self->{carriages}[0]->{start_percent}
		> $self->{carriages}[-1]->{start_percent} )
		{
		$self->{direction} = 100;
		}
		else {
		$self->{direction} = 0;
		}
		}

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

		sub destinations {
		my ($self) = @_;

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

		sub train_numbers {
		my ($self) = @_;

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

		sub trains {
		my ($self) = @_;

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

		sub sectors {
		my ($self) = @_;

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

		sub groups {
		my ($self) = @_;
		return @{ $self->{groups} // [] };
		}

		sub carriages {
		my ($self) = @_;
		return @{ $self->{carriages} // [] };
		}

		sub TO_JSON {
		my ($self) = @_;

		my $ret = { %{$self} };

		return $ret;
		}

		1;

lib/Travel/Status/DE/DBRIS/Formation/Carriage.pm

0 → 100644

+216 −0

Original line number	Diff line number	Diff line
		package Travel::Status::DE::DBRIS::Formation::Carriage;

		use strict;
		use warnings;
		use 5.020;
		use utf8;

		use parent 'Class::Accessor';
		use Carp qw(cluck);

		our $VERSION = '0.18';
		Travel::Status::DE::DBRIS::Formation::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
		has_priority_seats has_ac has_quiet_zone has_bahn_comfort has_wheelchair_space
		has_wheelchair_toilet has_family_zone has_infant_cabin has_info has_bistro
		has_first_class has_second_class
		)
		);

		my %type_map = (
		SEATS_SEVERELY_DISABLE => 'priority_seats',
		AIR_CONDITION => 'ac',
		ZONE_QUIET => 'quiet_zone',
		SEATS_BAHN_COMFORT => 'bahn_comfort',
		INFO => 'info',
		TOILET_WHEELCHAIR => 'wheelchair_toilet',
		WHEELCHAIR_SPACE => 'wheelchair_space',
		ZONE_FAMILY => 'family_zone',
		CABIN_INFANT => 'infant_cabin',
		);

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

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

		$self->parse_type;

		for my $amenity ( @{ $json{amenities} // [] } ) {
		my $type = $amenity->{type};
		if ( $type_map{$type} ) {
		my $key = 'has_' . $type_map{$type};
		$self->{$key} = 1;
		}
		}

		if ( $json{status} and $json{status} eq 'CLOSED' ) {
		$ref->{is_closed} = 1;
		}

		if ( $json{type}{category} =~ m{DININGCAR} ) {
		$ref->{has_bistro} = 1;
		}
		elsif ( $json{type}{category} eq 'LOCOMOTIVE' ) {
		$ref->{is_locomotive} = 1;
		}
		elsif ( $json{type}{category} eq 'POWERCAR' ) {
		$ref->{is_powercar} = 1;
		}

		$ref->{has_first_class} = $json{type}{hasFirstClass};
		$ref->{has_second_class} = $json{type}{hasEconomyClass};

		if ( $ref->{type} =~ m{AB} ) {
		$ref->{class_type} = 12;
		}
		elsif ( $ref->{type} =~ m{A} ) {
		$ref->{class_type} = 1;
		}
		elsif ( $ref->{type} =~ m{B\|WR} ) {
		$ref->{class_type} = 2;
		}

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

		$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->{start} eq ''
		or $pos->{end} eq '' )
		{
		$ref->{position}{valid} = 0;
		}
		else {
		$ref->{position}{valid} = 1;
		}

		return $self;
		}

		sub attributes {
		my ($self) = @_;

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

		# See also:
		# https://de.wikipedia.org/wiki/UIC-Bauart-Bezeichnungssystem_f%C3%BCr_Reisezugwagen#Kennbuchstaben
		# https://www.deutsche-reisezugwagen.de/lexikon/erklarung-der-gattungszeichen/
		sub parse_type {
		my ($self) = @_;

		my $type = $self->{type};
		my @desc;

		if ( $type =~ m{^D} ) {
		$self->{is_dosto} = 1;
		push( @desc, 'Doppelstock' );
		}

		if ( $type =~ m{b} ) {
		$self->{has_accessibility} = 1;
		push( @desc, 'Behindertengerechte Ausstattung' );
		}

		if ( $type =~ m{d} ) {
		$self->{multipurpose} = 1;
		push( @desc, 'Mehrzweck' );
		}

		if ( $type =~ m{f} ) {
		push( @desc, 'Steuerabteil' );
		}

		if ( $type =~ m{i} ) {
		push( @desc, 'Interregio' );
		}

		if ( $type =~ m{mm} ) {
		push( @desc, 'modernisiert' );
		}

		if ( $type =~ m{p} ) {
		$self->{has_ac} = 1;
		push( @desc, 'Großraum' );
		}

		if ( $type =~ m{s} ) {
		push( @desc, 'Sonderabteil' );
		}

		if ( $type =~ m{v} ) {
		$self->{has_ac} = 1;
		$self->{has_compartments} = 1;
		push( @desc, 'Abteil' );
		}

		if ( $type =~ m{w} ) {
		$self->{has_ac} = 1;
		$self->{has_compartments} = 1;
		push( @desc, 'Abteil' );
		}

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

		sub is_first_class {
		my ($self) = @_;

		if ( $self->{type} =~ m{^D?A} ) {
		return 1;
		}
		return 0;
		}

		sub is_second_class {
		my ($self) = @_;

		if ( $self->{type} =~ m{^D?A?B} ) {
		return 1;
		}
		return 0;
		}

		sub sections {
		my ($self) = @_;

		return @{ $self->{sections} };
		}

		sub TO_JSON {
		my ($self) = @_;

		my %copy = %{$self};

		return {%copy};
		}

		1;

lib/Travel/Status/DE/DBRIS/Formation/Group.pm

0 → 100644

+689 −0

File added.

Preview size limit exceeded, changes collapsed.

Admin message