Unverified Commit 830badd9 authored by Birte Kristina Friesel's avatar Birte Kristina Friesel
Browse files

Provide $journey->product->line_id in a line-colors compatible format 

See https://github.com/Traewelling/line-colors/blob/main/line-colors.csv

Closes #9
parent d45e7823

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

+8 −0
Original line number Diff line number Diff line
@@ -17,6 +17,7 @@ Travel::Status::DE::HAFAS::Journey->mk_ro_accessors( 
	qw(datetime sched_datetime rt_datetime

	  is_additional is_cancelled is_partially_cancelled

	  station station_eva platform sched_platform rt_platform operator

	  product

	  id name type type_long class number line line_no load delay

	  route_end route_start origin destination direction)

);
@@ -487,6 +488,13 @@ True if the journey was cancelled, false otherwise. 


True if part of the journey was cancelled, false otherwise.



=item $journey->product



Travel::Status::DE::HAFAS::Product(3pm) instance describing the product (mode

of transport, line number / ID, operator, ...) associated with this journey.

Note that journeys may be associated with multiple products -- see also

C<< $journey->route >> and C<< $stop->product >>.



=item $journey->rt_platform (station only)



Actual arrival/departure platform.

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

+23 −14
Original line number Diff line number Diff line
@@ -11,8 +11,7 @@ use parent 'Class::Accessor'; 
our $VERSION = '5.05';



Travel::Status::DE::HAFAS::Product->mk_ro_accessors(

	qw(name type type_long class number line line_no operator)

);

	qw(name type type_long class number line line_id line_no operator));



# {{{ Constructor
@@ -23,6 +22,10 @@ sub new { 
	my $common  = $opt{common};

	my $opL     = $common->{opL};



	# DB:

	# catIn / catOutS eq "IXr" => "ICE X Regio"? regional tickets are generally accepted

	#                          <= does not hold



	my $class    = $product->{cls};

	my $name     = $product->{addName} // $product->{name};

	my $line_no  = $product->{prodCtx}{line};
@@ -45,6 +48,11 @@ sub new { 
		$line_no = $product->{prodCtx}{matchId};

	}



	my $line_id;

	if ( $product->{prodCtx}{lineId} ) {

		$line_id = lc( $product->{prodCtx}{lineId} =~ s{_+}{-}gr );

	}



	my $operator;

	if ( defined $product->{oprX} ) {

		if ( my $opref = $opL->[ $product->{oprX} ] ) {
@@ -56,6 +64,7 @@ sub new { 
		name      => $name,

		number    => $train_no,

		line      => $name,

		line_id   => $line_id,

		line_no   => $line_no,

		type      => $cat,

		type_long => $catlong,