diff options
| -rw-r--r-- | Build.PL | 1 | ||||
| -rwxr-xr-x | bin/hafas-m | 30 | ||||
| -rw-r--r-- | cpanfile | 1 | ||||
| -rw-r--r-- | lib/Travel/Status/DE/HAFAS/Journey.pm | 26 | ||||
| -rw-r--r-- | lib/Travel/Status/DE/HAFAS/Stop.pm | 34 |
5 files changed, 77 insertions, 15 deletions
@@ -29,6 +29,7 @@ Module::Build->new( 'List::Util' => 0, 'LWP::UserAgent' => 0, 'LWP::Protocol::https' => 0, + 'Scalar::Util' => 0, }, script_files => 'bin/', sign => 1, diff --git a/bin/hafas-m b/bin/hafas-m index 7df631f..42b0681 100755 --- a/bin/hafas-m +++ b/bin/hafas-m @@ -371,9 +371,24 @@ elsif ( $opt{journey} ) { $delay_fmt = $delay_len + 3; } + my $message_id = 1; + for my $stop ( $result->route ) { + my $msg_line = q{}; + for my $message ( $stop->messages ) { + if ( $message->ref_count > 0 + and $message->code ne + 'text.journeystop.product.or.direction.changes.stop.message' + and $message->text ne 'Halt entfällt' ) + { + if ( not $message->{id} ) { + $message->{id} = $message_id++; + } + $msg_line .= sprintf( ' (%d)', $message->{id} ); + } + } printf( -"%5s %s %5s %-${delay_fmt}s%${occupancy_len}s%-${occupancy_len}s %s%s\n", +"%5s %s %5s %-${delay_fmt}s%${occupancy_len}s%-${occupancy_len}s %s%s%s\n", $stop->arr_cancelled ? '--:--' : ( $stop->arr ? $stop->arr->strftime('%H:%M') : q{} ), ( $stop->arr and $stop->dep ) ? '→' : q{ }, @@ -385,7 +400,8 @@ elsif ( $opt{journey} ) { $stop->load->{SECOND} ? display_occupancy( $stop->load->{SECOND} ) : q{}, $stop->loc->name, - $stop->direction ? sprintf( ' → %s', $stop->direction ) : q{} + $stop->direction ? sprintf( ' → %s', $stop->direction ) : q{}, + $msg_line, ); } @@ -401,6 +417,16 @@ elsif ( $opt{journey} ) { } printf( "%s\n", $msg->text ); } + + for my $msg ( $status->messages ) { + if ( $msg->{id} ) { + say ''; + if ( $msg->short ) { + printf( "(%d) %s\n", $msg->{id}, $msg->short ); + } + printf( "(%d) %s\n", $msg->{id}, $msg->text ); + } + } exit 0; } @@ -8,6 +8,7 @@ requires 'List::MoreUtils'; requires 'List::Util'; requires 'LWP::UserAgent'; requires 'LWP::Protocol::https'; +requires 'Scalar::Util'; on test => sub { requires 'File::Slurp'; diff --git a/lib/Travel/Status/DE/HAFAS/Journey.pm b/lib/Travel/Status/DE/HAFAS/Journey.pm index d8d63ff..eb00272 100644 --- a/lib/Travel/Status/DE/HAFAS/Journey.pm +++ b/lib/Travel/Status/DE/HAFAS/Journey.pm @@ -8,7 +8,8 @@ use 5.014; use parent 'Class::Accessor'; use DateTime::Format::Strptime; -use List::Util qw(any); +use List::Util qw(any); +use Scalar::Util qw(weaken); use Travel::Status::DE::HAFAS::Stop; our $VERSION = '5.00'; @@ -110,17 +111,18 @@ sub new { for my $stop ( @{ $journey->{stopL} // [] } ) { my $loc = $locL->[ $stop->{locX} ]; - push( - @stops, - { - loc => $loc, - stop => $stop, - common => $opt{common}, - date => $date, - datetime_ref => $datetime_ref, - strp_obj => $hafas->{strptime_obj}, - } - ); + my $stopref = { + loc => $loc, + stop => $stop, + common => $opt{common}, + hafas => $hafas, + date => $date, + datetime_ref => $datetime_ref, + }; + + weaken( $stopref->{hafas} ); + + push( @stops, $stopref ); $route_end = $loc->name; } diff --git a/lib/Travel/Status/DE/HAFAS/Stop.pm b/lib/Travel/Status/DE/HAFAS/Stop.pm index 5763465..5d2ab36 100644 --- a/lib/Travel/Status/DE/HAFAS/Stop.pm +++ b/lib/Travel/Status/DE/HAFAS/Stop.pm @@ -29,7 +29,8 @@ sub new { my $common = $opt{common}; my $date = $opt{date}; my $datetime_ref = $opt{datetime_ref}; - my $strp_obj = $opt{strp_obj}; + my $hafas = $opt{hafas}; + my $strp_obj = $opt{hafas}{strptime_obj}; my $sched_arr = $stop->{aTimeS}; my $rt_arr = $stop->{aTimeR}; @@ -69,6 +70,21 @@ sub new { my $arr_cancelled = $stop->{aCncl}; my $dep_cancelled = $stop->{dCncl}; + my @messages; + for my $msg ( @{ $stop->{msgL} // [] } ) { + if ( $msg->{type} eq 'REM' and defined $msg->{remX} ) { + push( @messages, + $hafas->add_message( $opt{common}{remL}[ $msg->{remX} ] ) ); + } + elsif ( $msg->{type} eq 'HIM' and defined $msg->{himX} ) { + push( @messages, + $hafas->add_message( $opt{common}{himL}[ $msg->{himX} ], 1 ) ); + } + else { + say "Unknown message type $msg->{type}"; + } + } + my $tco = {}; for my $tco_id ( @{ $stop->{dTrnCmpSX}{tcocX} // [] } ) { my $tco_kv = $common->{tcocL}[$tco_id]; @@ -94,6 +110,7 @@ sub new { is_changed_platform => $changed_platform, platform => $rt_platform // $sched_platform, load => $tco, + messages => \@messages, }; bless( $ref, $obj ); @@ -121,6 +138,15 @@ sub handle_day_change { return $timestr; } +sub messages { + my ($self) = @_; + + if ( $self->{messages} ) { + return @{ $self->{messages} }; + } + return; +} + sub TO_JSON { my ($self) = @_; @@ -225,6 +251,12 @@ Departure or arrival delay in minutes. Direction signage from this stop on, undef if unchanged. +=item $journey->messages + +List of Travel::Status::DE::HAFAS::Message(3pm) instances related to this stop. +These typically refer to delay reasons, platform changes, or changes in the +line number / direction heading. + =item $stop->rt_platform Actual platform. |