make origins and destinations work with groups; add train_nos (f1f04bb7) · Commits · derf / Travel-Status-DE-DBWagenreihung

lib/Travel/Status/DE/DBWagenreihung.pm

+46 −35

Original line number	Original line	Diff line number	Diff line
	@@ -181,7 +181,7 @@ sub get_wagonorder {
	if ( @{ $json->{data}{istformation}{allFahrzeuggruppe} // [] } == 0		if ( @{ $json->{data}{istformation}{allFahrzeuggruppe} // [] } == 0
	and @{ $json->{data}{istformation}{halt} // [] } == 0 )		and @{ $json->{data}{istformation}{halt} // [] } == 0 )
	{		{
	$self->{errstr} = 'No wagon order available';		$self->{errstr} = 'No carriage formation available';
	return;		return;
	}		}

	@@ -277,29 +277,35 @@ sub parse_wagonorder {
	$self->{train_no} = $self->{data}{istformation}{zugnummer};		$self->{train_no} = $self->{data}{istformation}{zugnummer};

	$self->parse_wagons;		$self->parse_wagons;
	$self->{origins} = $self->parse_wings('startbetriebsstellename');		$self->{origins} = $self->merge_group_attr('origin');
	$self->{destinations} = $self->parse_wings('zielbetriebsstellename');		$self->{destinations} = $self->merge_group_attr('destination');
			$self->{train_nos} = $self->merge_group_attr('train_no');
	}		}

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

	my @names;		my @attrs;
	my %section;		my %attr_to_group;
			my %attr_to_sections;

	for my $group ( @{ $self->{data}{istformation}{allFahrzeuggruppe} } ) {		for my $group ( $self->groups ) {
	my $name = $group->{$attr};		push( @attrs, $group->{$attr} );
	my @sections = map { $_->{fahrzeugsektor} } @{ $group->{allFahrzeug} };		push( @{ $attr_to_group{ $group->{$attr} } }, $group );
	push( @{ $section{$name} }, @sections );		push( @{ $attr_to_sections{ $group->{$attr} } }, $group->sections );
	push( @names, $name );
	}		}

	@names = uniq @names;		@attrs = uniq @attrs;

	@names
	= map { { name => $_, sections => [ uniq @{ $section{$_} } ] } } @names;

	return \@names;		return [
			map {
			{
			name => $_,
			groups => $attr_to_group{$_},
			sections => $attr_to_sections{$_}
			}
			} @attrs
			];
	}		}

	sub parse_wagons {		sub parse_wagons {
	@@ -328,7 +334,8 @@ sub parse_wagons {
	);		);
	push( @wagon_groups, $group_obj );		push( @wagon_groups, $group_obj );

	my ( $short, $desc ) = $self->wagongroup_description( $group_obj->wagons );		my ( $short, $desc )
			= $self->wagongroup_description( $group_obj->wagons );
	my @sections = uniq map { $_->section } $group_obj->wagons;		my @sections = uniq map { $_->section } $group_obj->wagons;

	if ( @sections and length( join( q{}, @sections ) ) ) {		if ( @sections and length( join( q{}, @sections ) ) ) {
	@@ -386,6 +393,12 @@ sub origins {
	return @{ $self->{origins} // [] };		return @{ $self->{origins} // [] };
	}		}

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

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

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

	@@ -813,15 +826,10 @@ Train number. Do not include the train type: Use "8" for "EC 8" or

	=item $wr->destinations		=item $wr->destinations

	Returns a list describing the destinations of this train's carriages. In most		Returns a list describing the unique destinations of this train's carriage
	cases, it contains one element. For trains consisting of multiple wings or		groups. Each origin is a hashref that contains its B<name>, a B<groups>
	trains that switch locomotives along the way, it contains one element for each		arrayref to the corresponding Travel::Status::DE::DBWagenreihung::Group(3pm)
	wing or other kind of carriage group.		objects, and a B<sections> arrayref to section identifiers (subject to change).

	Each destination is a hash ref containing its B<name> and the corresponding
	platform I<sections> (at the moment, this is a list of section identifiers).

	This function is subject to change.

	=item $wr->direction		=item $wr->direction

	@@ -836,15 +844,10 @@ Returns undef otherwise.

	=item $wr->origins		=item $wr->origins

	Returns a list describing the origins of this train's carriages. In most		Returns a list describing the unique origins of this train's carriage groups.
	cases, it contains one element. For trains consisting of multiple wings or		Each origin is a hashref that contains its B<name>, a B<groups> arrayref to the
	trains that switch locomotives along the way, it contains one element for each		corresponding Travel::Status::DE::DBWagenreihung::Group(3pm) objects, and
	wing or other kind of carriage group.		a B<sections> arrayref to section identifiers (subject to change).

	Each origin is a hash ref containing its B<name> and the corresponding
	platform I<sections> (at the moment, this is a list of section identifiers).

	This function is subject to change.

	=item $wr->platform		=item $wr->platform

	@@ -867,6 +870,14 @@ Returns the list of train numbers for this departure. In most cases, this is
	just one element. For trains consisting of multiple wings (which typically have		just one element. For trains consisting of multiple wings (which typically have
	different numbers), it contains one element for each wing.		different numbers), it contains one element for each wing.

			=item $wr->train_nos

			Returns a list describing the unique train numbers associated with this train's
			carriage groups. Each train number is a hashref that contains its B<name>
			(i.e., number), a B<groups> arrayref to the corresponding
			Travel::Status::DE::DBWagenreihung::Group(3pm) objects, and a B<sections>
			arrayref to section identifiers (subject to change).

	=item $wr->train_type		=item $wr->train_type

	Returns a string describing the train type, e.g. "ICE" or "IC".		Returns a string describing the train type, e.g. "ICE" or "IC".

Admin message