diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Travel/Status/DE/DBWagenreihung.pm | 35 | ||||
-rw-r--r-- | lib/Travel/Status/DE/DBWagenreihung/Group.pm | 52 |
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; |