summaryrefslogtreecommitdiff
path: root/lib/Travel
diff options
context:
space:
mode:
authorBirte Kristina Friesel <derf@finalrewind.org>2024-04-27 18:16:13 +0200
committerBirte Kristina Friesel <derf@finalrewind.org>2024-04-27 18:16:13 +0200
commit11a58c8e0292b45694759a07bd150a0fdb852a8f (patch)
tree7c495f9294b1ef09940e7a64fd55548e61b3bdc1 /lib/Travel
parent4c6612a0656abcc930a82f2d4ea310e16186156c (diff)
Explicitly group wagons, just as the backend does
Diffstat (limited to 'lib/Travel')
-rw-r--r--lib/Travel/Status/DE/DBWagenreihung.pm35
-rw-r--r--lib/Travel/Status/DE/DBWagenreihung/Group.pm52
2 files changed, 77 insertions, 10 deletions
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;