Implement journeyMatch requests (3c033327) · Commits · derf / Travel-Status-DE-HAFAS

bin/hafas-m

+35 −4

Original line number	Diff line number	Diff line
		@@ -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.

lib/Travel/Status/DE/HAFAS.pm

+78 −4

Original line number	Diff line number	Diff line
		@@ -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

Admin message