Implement journeyMatch requests

2 files changed, 113 insertions, 8 deletions

diff --git a/bin/hafas-m b/bin/hafas-m
index fb1f71b..6484387 100755
--- a/bin/hafas-m
+++ b/bin/hafas-m
@@ -84,6 +84,10 @@ elsif ( $opt{station} =~ m{[|]} ) {
 	$opt{journey} = { id => $opt{station} };
 	delete $opt{station};
 }
+elsif ( $opt{station} =~ m{ ^ [!] (?<query> .*) $ }x ) {
+	$opt{journeyMatch} = $+{query};
+	delete $opt{station};
+}
 
 if ( $date or $time ) {
 	my $dt = DateTime->now( time_zone => 'Europe/Berlin' );
@@ -337,6 +341,28 @@ elsif ( $opt{journey} ) {
 	}
 	exit 0;
 }
+elsif ( $opt{journeyMatch} ) {
+	for my $result ( $status->results ) {
+		my $start = ( $result->route )[0];
+		my $end   = ( $result->route )[-1];
+		say $result->id;
+		print $result->name;
+		if ( $result->number ) {
+			printf( "  |  Zug  %s", $result->number );
+		}
+		if ( $result->line_no ) {
+			printf( "  |  Linie %s", $result->line_no );
+		}
+		say q{};
+		printf( "%s  ab  %s\n",
+			$start->dep->strftime('%H:%M'),
+			$start->loc->name );
+		printf( "%s  an  %s\n\n",
+			$end->arr->strftime('%H:%M'),
+			$end->loc->name );
+	}
+	exit 0;
+}
 
 my $message_id = 1;
 for my $m ( $status->messages ) {
@@ -399,7 +425,7 @@ B<hafas-m> [B<-d> I<date>] [B<-t> I<time>] [B<-m> I<motlist>]
 
 B<hafas-m> [B<-s> I<service>] B<?>I<query>|I<lat>B<:>I<lon>
 
-B<hafas-m> [B<-s> I<service>] [B<-l> I<language>] I<journeyID>
+B<hafas-m> [B<-s> I<service>] [B<-l> I<language>] B<!>I<query>|I<journeyID>
 
 =head1 VERSION
 
@@ -412,7 +438,7 @@ available at L<https://reiseauskunft.bahn.de//bin/bhftafel.exe/dn>.
 
 It has three operating modes that depend on the contents of its argument.
 
-=head2 Arrival/Departure Monitor
+=head2 Arrival/Departure Monitor (I<station>)
 
 Show departures (or arrivals) at I<station>, optionally filtered by date, time
 and mode of transport. I<station> may be given as a station name or EVA ID.
@@ -438,12 +464,17 @@ codes. Output format:
 Occupancy indicators are, from least occupied to fully booked: B<.> B<o>
 B<*> B<!>.
 
-=head2 Location Search
+=head2 Location Search (B<!>I<query>|I<lat>B<:>I<lon>)
 
 List stations that match I<query> or that are located in the vicinity of
 I<lat>B<:>I<lon> geocoordinates with EVA ID and name.
 
-=head2 Trip Details
+=head2 Trip Search (B<!>I<query>)
+
+List journey IDs that match the train numer I<query> (e.g. "ICE 205" or
+"S 31111").
+
+=head2 Trip Details (I<journeyID>)
 
 List intermediate stops of I<journeyID> with arrival/departure time, delay (if
 available), occupancy (if available), and stop name.
diff --git a/lib/Travel/Status/DE/HAFAS.pm b/lib/Travel/Status/DE/HAFAS.pm
index c085f4a..c49551a 100644
--- a/lib/Travel/Status/DE/HAFAS.pm
+++ b/lib/Travel/Status/DE/HAFAS.pm
@@ -198,12 +198,14 @@ sub new {
 	if (
 		not(   $conf{station}
 			or $conf{journey}
+			or $conf{journeyMatch}
 			or $conf{geoSearch}
 			or $conf{locationSearch} )
 	  )
 	{
 		confess(
-			'station / journey / geoSearch / locationSearch must be specified');
+'station / journey / journeyMatch / geoSearch / locationSearch must be specified'
+		);
 	}
 
 	if ( not defined $service ) {
@@ -248,6 +250,27 @@ sub new {
 			%{ $hafas_instance{$service}{request} }
 		};
 	}
+	elsif ( $conf{journeyMatch} ) {
+		$req = {
+			svcReqL => [
+				{
+					meth => 'JourneyMatch',
+					req  => {
+						date => ( $conf{datetime} // $now )->strftime('%Y%m%d'),
+						input    => $conf{journeyMatch},
+						jnyFltrL => [
+							{
+								type  => "PROD",
+								mode  => "INC",
+								value => $self->mot_mask
+							}
+						]
+					},
+				}
+			],
+			%{ $hafas_instance{$service}{request} }
+		};
+	}
 	elsif ( $conf{geoSearch} ) {
 		$req = {
 			svcReqL => [
@@ -406,6 +429,9 @@ sub new {
 	if ( $conf{journey} ) {
 		$self->parse_journey;
 	}
+	elsif ( $conf{journeyMatch} ) {
+		$self->parse_journey_match;
+	}
 	elsif ( $conf{geoSearch} or $conf{locationSearch} ) {
 		$self->parse_search;
 	}
@@ -423,11 +449,14 @@ sub new_p {
 	if (
 		not(   $conf{station}
 			or $conf{journey}
+			or $conf{journeyMatch}
 			or $conf{geoSearch}
 			or $conf{locationSearch} )
 	  )
 	{
-		return $promise->reject('station or journey flag must be passed');
+		return $promise->reject(
+'station / journey / journeyMatch / geoSearch / locationSearch flag must be passed'
+		);
 	}
 
 	my $self = $obj->new( %conf, async => 1 );
@@ -441,6 +470,9 @@ sub new_p {
 			if ( $conf{journey} ) {
 				$self->parse_journey;
 			}
+			elsif ( $conf{journeyMatch} ) {
+				$self->parse_journey_match;
+			}
 			elsif ( $conf{geoSearch} or $conf{locationSearch} ) {
 				$self->parse_search;
 			}
@@ -700,6 +732,34 @@ sub parse_journey {
 	return $self;
 }
 
+sub parse_journey_match {
+	my ($self) = @_;
+
+	$self->{results} = [];
+
+	if ( $self->{errstr} ) {
+		return $self;
+	}
+
+	my @locL = map { Travel::Status::DE::HAFAS::Location->new( loc => $_ ) }
+	  @{ $self->{raw_json}{svcResL}[0]{res}{common}{locL} // [] };
+
+	my @jnyL = @{ $self->{raw_json}{svcResL}[0]{res}{jnyL} // [] };
+
+	for my $result (@jnyL) {
+		push(
+			@{ $self->{results} },
+			Travel::Status::DE::HAFAS::Journey->new(
+				common  => $self->{raw_json}{svcResL}[0]{res}{common},
+				locL    => \@locL,
+				journey => $result,
+				hafas   => $self,
+			)
+		);
+	}
+	return $self;
+}
+
 sub parse_board {
 	my ($self) = @_;
 
@@ -950,6 +1010,14 @@ Results are available via C<< $status->results >>.
 Request details about the journey identified by I<tripid> and I<line>.
 The result is available via C<< $status->result >>.
 
+=item B<journeyMatch> => I<query>
+
+Request journeys that match I<query> (e.g. "ICE 205" or "S 31111").
+Results are available via C<< $status->results >>.
+In contrast to B<journey>, the results typically only contain a minimal amount
+of information: trip ID, train/line identifier, and first and last stop.  There
+is no real-time data.
+
 =back
 
 The following optional flags may be set.
@@ -973,14 +1041,14 @@ minutes.
 
 Date and time to report for.  Defaults to now.
 
-=item B<excluded_mots> => [I<mot1>, I<mot2>, ...] (geoSearch, station)
+=item B<excluded_mots> => [I<mot1>, I<mot2>, ...] (geoSearch, station, journeyMatch)
 
 By default, all modes of transport (trains, trams, buses etc.) are returned.
 If this option is set, all modes appearing in I<mot1>, I<mot2>, ... will
 be excluded. The supported modes depend on B<service>, use
 B<get_services> or B<get_service> to get the supported values.
 
-=item B<exclusive_mots> => [I<mot1>, I<mot2>, ...] (geoSearch, station)
+=item B<exclusive_mots> => [I<mot1>, I<mot2>, ...] (geoSearch, station, journeyMatch)
 
 If this option is set, only the modes of transport appearing in I<mot1>,
 I<mot2>, ...  will be returned.  The supported modes depend on B<service>, use
@@ -1069,6 +1137,12 @@ Travel::Status::DE::HAFAS::Journey(3pm) object.
 If no matching results were found or the parser / http request failed, returns
 undef.
 
+=item $status->results (journeyMatch)
+
+Returns a list of Travel::Status::DE::HAFAS::Journey(3pm) object that describe
+matching journeys. In general, these objects lack real-time data,
+intermediate stops, and more.
+
 =item $status->result (journey)
 
 Returns a single Travel::Status::DE::HAFAS::Journey(3pm) object that describes