Unverified Commit 9d928f5c authored by Birte Kristina Friesel's avatar Birte Kristina Friesel
Browse files

Add support for stop-specific messages in journeys

parent 6c2ebcb3

Build.PL

+1 −0
Original line number Diff line number Diff line
@@ -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,

bin/hafas-m

+28 −2
Original line number Diff line number Diff line
@@ -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;

}

cpanfile

+1 −0
Original line number Diff line number Diff line
@@ -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';

lib/Travel/Status/DE/HAFAS/Journey.pm

+14 −12
Original line number Diff line number Diff line
@@ -9,6 +9,7 @@ use 5.014; 
use parent 'Class::Accessor';

use DateTime::Format::Strptime;

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,

			{

		my $stopref = {

			loc          => $loc,

			stop         => $stop,

			common       => $opt{common},

			hafas        => $hafas,

			date         => $date,

			datetime_ref => $datetime_ref,

				strp_obj     => $hafas->{strptime_obj},

			}

		);

		};



		weaken( $stopref->{hafas} );



		push( @stops, $stopref );



		$route_end = $loc->name;

	}

lib/Travel/Status/DE/HAFAS/Stop.pm

+33 −1
Original line number Diff line number Diff line
@@ -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.