Journey: Rework train/line accessors

3 files changed, 63 insertions, 76 deletions

diff --git a/Changelog b/Changelog
index 595c453..a476189 100644
--- a/Changelog
+++ b/Changelog
@@ -20,8 +20,9 @@ git HEAD
     * Travel::Status::DE::HAFAS: Add "result" and "messages" accessors.
     * Rename Travel::Status::DE::HAFAS::Result to ...::Journey. The accessors
       "sched_date", "date", "info", "countdown", "countdown_sec",
-      "raw_e_delay", "raw_delay", "sched_time" and "time" are no longer
-      supported. Introduces several new accessors instead.
+      "raw_e_delay", "raw_delay", "sched_time", "time", "train", "train_no"
+      and "line_no" are no longer supported. Introduces several new 
+      instead.
     * The module no longer depends on XML::LibXML
     * New dependency: Digest::MD5
 
diff --git a/bin/hafas-m b/bin/hafas-m
index 66c2ca2..a17443f 100755
--- a/bin/hafas-m
+++ b/bin/hafas-m
@@ -269,7 +269,7 @@ for my $d ( $status->results ) {
 			$d->is_cancelled
 			? 'CANCELED'
 			: ( $d->delay ? sprintf( '%+d', $d->delay ) : q{} ),
-			$d->train,
+			$d->name,
 			$d->route_end,
 			( $d->platform // q{} ) . ( $d->is_changed_platform ? ' !' : q{} ),
 			$info_line,
diff --git a/lib/Travel/Status/DE/HAFAS/Journey.pm b/lib/Travel/Status/DE/HAFAS/Journey.pm
index 6963b8f..9f5b040 100644
--- a/lib/Travel/Status/DE/HAFAS/Journey.pm
+++ b/lib/Travel/Status/DE/HAFAS/Journey.pm
@@ -15,7 +15,8 @@ our $VERSION = '3.01';
 Travel::Status::DE::HAFAS::Journey->mk_ro_accessors(
 	qw(datetime sched_datetime rt_datetime is_cancelled operator delay
 	  platform sched_platform rt_platform
-	  train route_end route_start origin destination direction)
+	  id name type type_long number line
+	  route_end route_start origin destination direction)
 );
 
 # {{{ Constructor
@@ -39,10 +40,27 @@ sub new {
 	my $is_cancelled = $journey->{isCncl};
 	my $jid          = $journey->{jid};
 
-	my $product    = $prodL[ $journey->{prodX} ];
-	my $train      = $product->{prodCtx}{name};
-	my $train_type = $product->{prodCtx}{catOutS};
-	my $line_no    = $product->{prodCtx}{line};
+	my $product  = $prodL[ $journey->{prodX} ];
+	my $name     = $product->{addName} // $product->{name};
+	my $line_no  = $product->{prodCtx}{line};
+	my $train_no = $product->{prodCtx}{num};
+	my $cat      = $product->{prodCtx}{catOut};
+	my $catlong  = $product->{prodCtx}{catOutL};
+	if ( $name eq $cat ) {
+		$name .= ' ' . $product->{nameS};
+	}
+	if ( defined $train_no and not $train_no ) {
+		$train_no = undef;
+	}
+	if (
+		    not defined $line_no
+		and defined $product->{prodCtx}{matchId}
+		and
+		( not defined $train_no or $product->{prodCtx}{matchId} ne $train_no )
+	  )
+	{
+		$line_no = $product->{prodCtx}{matchId};
+	}
 
 	my $operator;
 	if ( defined $product->{oprX} ) {
@@ -128,10 +146,15 @@ sub new {
 
 	my $ref = {
 		datetime_now => $hafas->{now},
-		is_cancelled => $is_cancelled,
-		train        => $train,
+		id           => $jid,
+		name         => $name,
+		number       => $train_no,
+		line         => $line_no,
+		type         => $cat,
+		type_long    => $catlong,
 		operator     => $operator,
 		direction    => $direction,
+		is_cancelled => $is_cancelled,
 		route_end    => $stops[-1]{name},
 		messages     => \@messages,
 		route        => \@stops,
@@ -196,12 +219,6 @@ sub new {
 
 # {{{ Accessors
 
-sub line {
-	my ($self) = @_;
-
-	return $self->{train};
-}
-
 sub is_changed_platform {
 	my ($self) = @_;
 
@@ -267,42 +284,6 @@ sub TO_JSON {
 	return $ret;
 }
 
-sub type {
-	my ($self) = @_;
-	my $type;
-
-	# $self->{train} is either "TYPE 12345" or "TYPE12345"
-	if ( $self->{train} =~ m{ \s }x ) {
-		($type) = ( $self->{train} =~ m{ ^ ([^[:space:]]+) }x );
-	}
-	else {
-		($type) = ( $self->{train} =~ m{ ^ ([[:alpha:]]+) }x );
-	}
-
-	return $type;
-}
-
-sub line_no {
-	my ($self) = @_;
-	my $line_no;
-
-	# $self->{train} is either "TYPE 12345" or "TYPE12345"
-	if ( $self->{train} =~ m{ \s }x ) {
-		($line_no) = ( $self->{train} =~ m{ ([^[:space:]]+) $ }x );
-	}
-	else {
-		($line_no) = ( $self->{train} =~ m{ ([[:digit:]]+) $ }x );
-	}
-
-	return $line_no;
-}
-
-sub train_no {
-	my ($self) = @_;
-
-	return $self->line_no;
-}
-
 # }}}
 
 1;
@@ -356,6 +337,35 @@ undef for non-station results.
 
 =over
 
+=item $result->name
+
+Returns the journey or line name, either in a format like "Bus SB16" (Bus line
+SB16) or "RE 10111" (RegionalExpress train 10111, no line information).  May
+contain extraneous whitespace characters.
+
+=item $result->type
+
+Returns the type of this result, e.g. "S" for S-Bahn, "RE" for Regional Express
+or "STR" for tram / StraE<szlig>enbahn.
+
+=item $result->type_long
+
+Returns the long type of this result, e.g. "S-Bahn" or "Regional-Express".
+
+=item $result->line
+
+Returns the line identifier, or undef if it is unknown.
+The line identifier may be a single number such as "11" (underground train
+line U 11), a single word (e.g. "AIR") or a combination (e.g. "SB16").
+
+=item $result->number
+
+Returns the journey number (e.g. train number), or undef if it is unknown.
+
+=item $result->id
+
+Returns tha HAFAS-internal journey ID.
+
 =item $result->rt_datetime (station only)
 
 DateTime object indicating the actual arrival/departure date and time.
@@ -406,35 +416,11 @@ Returns a list of message strings related to this result. Messages usually are
 service notices (e.g. "missing carriage") or detailed delay reasons
 (e.g. "switch damage between X and Y, expect delays").
 
-=item $result->line
-
-=item $result->train
-
-Returns the line name, either in a format like "Bus SB16" (Bus line SB16)
-or "RE 10111" (RegionalExpress train 10111, no line information).
-May contain extraneous whitespace characters.
-
-=item $result->type
-
-Returns the type of this result, e.g. "S" for S-Bahn, "RE" for Regional Express
-or "STR" for tram / StraE<szlig>enbahn.
-
-=item $result->line_no
-
-=item $result->train_no
-
-Returns the line/train number, for instance "SB16" (bus line SB16),
-"11" (Underground train line U 11) or 1011 ("RegionalExpress train 1011").
-Note that this may not be a number at all: Some transport services also
-use single-letter characters or words (e.g. "AIR") as line numbers.
-
 =item $result->operator
 
 Returns the operator responsible for this journey. Returns undef
 if the backend does not provide an operator.
 
-Note that E<Ouml>BB is the only known backend providing this information.
-
 =item $result->route
 
 Returns a list of hashes; each hash describes a single journey stop.