diff options
-rwxr-xr-x | bin/db-wagenreihung | 32 | ||||
-rw-r--r-- | lib/Travel/Status/DE/DBWagenreihung.pm | 45 | ||||
-rw-r--r-- | lib/Travel/Status/DE/DBWagenreihung/Group.pm | 24 |
3 files changed, 68 insertions, 33 deletions
diff --git a/bin/db-wagenreihung b/bin/db-wagenreihung index c1daac1..0f13c54 100755 --- a/bin/db-wagenreihung +++ b/bin/db-wagenreihung @@ -149,22 +149,30 @@ for my $wagon ( $wr->wagons ) { print $wr->direction == 100 ? '>' : '<'; print "\n\n"; -for my $desc ( $wr->train_descriptions ) { - if ( $desc->{text} ) { +for my $group ( $wr->groups ) { + if ( $group->has_sections ) { printf( "%s (%s)\n", - $desc->{text}, join( q{}, @{ $desc->{sections} } ) ); + $group->description || 'Zug', + join( q{}, $group->sections ) ); + } + else { + say $group->description || 'Zug'; } -} - -say ""; - -for my $wagon ( $wr->wagons ) { printf( - "%3s: %3s %10s %s\n", - $wagon->is_closed ? 'X' : ( $wagon->number || '?' ), - $wagon->model || '???', - $wagon->type, join( q{ }, $wagon->attributes ) + "%s %s %s → %s\n\n", + $wr->train_type, $group->train_no, + $group->origin, $group->destination ); + + for my $wagon ( $group->wagons ) { + printf( + "%3s: %3s %10s %s\n", + $wagon->is_closed ? 'X' : ( $wagon->number || '?' ), + $wagon->model || '???', + $wagon->type, join( q{ }, $wagon->attributes ) + ); + } + say ""; } __END__ diff --git a/lib/Travel/Status/DE/DBWagenreihung.pm b/lib/Travel/Status/DE/DBWagenreihung.pm index ea14ec9..6c33971 100644 --- a/lib/Travel/Status/DE/DBWagenreihung.pm +++ b/lib/Travel/Status/DE/DBWagenreihung.pm @@ -261,6 +261,29 @@ sub wagongroup_powertype { return $likelihood[0]; } +sub parse_train_descriptions { + my ($self) = @_; + + for my $group ( @{ $self->{wagongroups} } ) { + my ( $short, $desc ) = $self->wagongroup_description( $group->wagons ); + my @sections = uniq map { $_->section } $group->wagons; + + if ( @sections and length( join( q{}, @sections ) ) ) { + $group->set_sections(@sections); + } + $group->set_description( $desc, $short ); + + push( + @{ $self->{train_descriptions} }, + { + sections => [@sections], + short => $short, + text => $desc, + } + ); + } +} + sub parse_wagonorder { my ($self) = @_; @@ -276,6 +299,7 @@ sub parse_wagonorder { $self->{train_no} = $self->{data}{istformation}{zugnummer}; $self->parse_wagons; + $self->parse_train_descriptions; $self->{origins} = $self->parse_wings('startbetriebsstellename'); $self->{destinations} = $self->parse_wings('zielbetriebsstellename'); } @@ -406,26 +430,7 @@ sub sections { sub train_descriptions { my ($self) = @_; - - if ( exists $self->{train_descriptions} ) { - return @{ $self->{train_descriptions} }; - } - - for my $group ( @{ $self->{wagongroups} } ) { - my ( $short, $desc ) = $self->wagongroup_description( $group->wagons ); - my @sections = uniq map { $_->section } $group->wagons; - - push( - @{ $self->{train_descriptions} }, - { - sections => [@sections], - short => $short, - text => $desc, - } - ); - } - - return @{ $self->{train_descriptions} }; + return @{ $self->{train_descriptions} // [] }; } sub train_numbers { diff --git a/lib/Travel/Status/DE/DBWagenreihung/Group.pm b/lib/Travel/Status/DE/DBWagenreihung/Group.pm index 76fc159..a627b6e 100644 --- a/lib/Travel/Status/DE/DBWagenreihung/Group.pm +++ b/lib/Travel/Status/DE/DBWagenreihung/Group.pm @@ -10,7 +10,8 @@ use parent 'Class::Accessor'; our $VERSION = '0.13'; Travel::Status::DE::DBWagenreihung::Group->mk_ro_accessors( - qw(id train_no type origin destination)); + qw(id train_no type description desc_short origin destination has_sections) +); sub new { my ( $obj, %opt ) = @_; @@ -19,6 +20,21 @@ sub new { return bless( $ref, $obj ); } +sub set_description { + my ( $self, $desc, $short ) = @_; + + $self->{description} = $desc; + $self->{desc_short} = $short; +} + +sub set_sections { + my ( $self, @sections ) = @_; + + $self->{sections} = [@sections]; + + $self->{has_sections} = 1; +} + sub set_traintype { my ( $self, $i, $tt ) = @_; $self->{type} = $tt; @@ -35,6 +51,12 @@ sub sort_wagons { @{ $self->{wagons} }; } +sub sections { + my ($self) = @_; + + return @{ $self->{sections} // [] }; +} + sub wagons { my ($self) = @_; |