From 11a58c8e0292b45694759a07bd150a0fdb852a8f Mon Sep 17 00:00:00 2001
From: Birte Kristina Friesel <derf@finalrewind.org>
Date: Sat, 27 Apr 2024 18:16:13 +0200
Subject: Explicitly group wagons, just as the backend does

---
 lib/Travel/Status/DE/DBWagenreihung.pm       | 35 +++++++++++++------
 lib/Travel/Status/DE/DBWagenreihung/Group.pm | 52 ++++++++++++++++++++++++++++
 2 files changed, 77 insertions(+), 10 deletions(-)
 create mode 100644 lib/Travel/Status/DE/DBWagenreihung/Group.pm

(limited to 'lib')

diff --git a/lib/Travel/Status/DE/DBWagenreihung.pm b/lib/Travel/Status/DE/DBWagenreihung.pm
index 27ec01d..64fe913 100644
--- a/lib/Travel/Status/DE/DBWagenreihung.pm
+++ b/lib/Travel/Status/DE/DBWagenreihung.pm
@@ -11,6 +11,7 @@ use Carp qw(cluck confess);
 use JSON;
 use List::Util qw(uniq);
 use LWP::UserAgent;
+use Travel::Status::DE::DBWagenreihung::Group;
 use Travel::Status::DE::DBWagenreihung::Section;
 use Travel::Status::DE::DBWagenreihung::Wagon;
 
@@ -306,18 +307,25 @@ sub parse_wagons {
 	my @wagon_groups;
 
 	for my $group ( @{ $self->{data}{istformation}{allFahrzeuggruppe} } ) {
-		my @group;
+		my @group_wagons;
 		for my $wagon ( @{ $group->{allFahrzeug} } ) {
 			my $wagon_object
 			  = Travel::Status::DE::DBWagenreihung::Wagon->new( %{$wagon},
 				train_no => $group->{verkehrlichezugnummer} );
 			push( @{ $self->{wagons} }, $wagon_object );
-			push( @group,               $wagon_object );
+			push( @group_wagons,        $wagon_object );
 			if ( not $wagon_object->{position}{valid} ) {
 				$self->{has_bad_wagons} = 1;
 			}
 		}
-		push( @wagon_groups, [@group] );
+		my $group_obj = Travel::Status::DE::DBWagenreihung::Group->new(
+			id          => $group->{fahrzeuggruppebezeichnung},
+			train_no    => $group->{verkehrlichezugnummer},
+			origin      => $group->{startbetriebsstellename},
+			destination => $group->{zielbetriebsstellename},
+			wagons      => \@group_wagons,
+		);
+		push( @wagon_groups, $group_obj );
 	}
 	if ( @{ $self->{wagons} // [] } > 1 and not $self->has_bad_wagons ) {
 		if ( $self->{wagons}[0]->{position}{start_percent}
@@ -333,14 +341,16 @@ sub parse_wagons {
 		@{ $self->{wagons} } = sort {
 			$a->{position}->{start_percent} <=> $b->{position}->{start_percent}
 		} @{ $self->{wagons} };
+		for my $group (@wagon_groups) {
+			$group->sort_wagons;
+		}
 	}
 
 	for my $i ( 0 .. $#wagon_groups ) {
 		my $group = $wagon_groups[$i];
-		my $tt    = $self->wagongroup_subtype( @{$group} );
-		for my $wagon ( @{$group} ) {
-			$wagon->set_traintype( $i, $tt );
-		}
+		my $tt    = $self->wagongroup_subtype( $group->wagons );
+		$group->set_traintype( $i, $tt );
+		$group->{type} = $tt;
 	}
 
 	$self->{wagongroups} = [@wagon_groups];
@@ -401,9 +411,9 @@ sub train_descriptions {
 		return @{ $self->{train_descriptions} };
 	}
 
-	for my $wagons ( @{ $self->{wagongroups} } ) {
-		my ( $short, $desc ) = $self->wagongroup_description( @{$wagons} );
-		my @sections = uniq map { $_->section } @{$wagons};
+	for my $group ( @{ $self->{wagongroups} } ) {
+		my ( $short, $desc ) = $self->wagongroup_description( $group->wagons );
+		my @sections = uniq map { $_->section } $group->wagons;
 
 		push(
 			@{ $self->{train_descriptions} },
@@ -706,6 +716,11 @@ sub wagongroup_subtype {
 	return $likelihood[0];
 }
 
+sub groups {
+	my ($self) = @_;
+	return @{ $self->{wagongroups} // [] };
+}
+
 sub wagons {
 	my ($self) = @_;
 	return @{ $self->{wagons} // [] };
diff --git a/lib/Travel/Status/DE/DBWagenreihung/Group.pm b/lib/Travel/Status/DE/DBWagenreihung/Group.pm
new file mode 100644
index 0000000..76fc159
--- /dev/null
+++ b/lib/Travel/Status/DE/DBWagenreihung/Group.pm
@@ -0,0 +1,52 @@
+package Travel::Status::DE::DBWagenreihung::Group;
+
+use strict;
+use warnings;
+use 5.020;
+use utf8;
+
+use parent 'Class::Accessor';
+
+our $VERSION = '0.13';
+
+Travel::Status::DE::DBWagenreihung::Group->mk_ro_accessors(
+	qw(id train_no type origin destination));
+
+sub new {
+	my ( $obj, %opt ) = @_;
+	my $ref = \%opt;
+
+	return bless( $ref, $obj );
+}
+
+sub set_traintype {
+	my ( $self, $i, $tt ) = @_;
+	$self->{type} = $tt;
+	for my $wagon ( $self->wagons ) {
+		$wagon->set_traintype( $i, $tt );
+	}
+}
+
+sub sort_wagons {
+	my ($self) = @_;
+
+	@{ $self->{wagons} }
+	  = sort { $a->{position}{start_percent} <=> $b->{position}{start_percent} }
+	  @{ $self->{wagons} };
+}
+
+sub wagons {
+	my ($self) = @_;
+
+	return @{ $self->{wagons} // [] };
+}
+
+sub TO_JSON {
+	my ($self) = @_;
+
+	my %copy = %{$self};
+
+	return {%copy};
+}
+
+1;
-- 
cgit v1.2.3