add HAFAS StopFinder module

1 files changed, 205 insertions, 0 deletions

diff --git a/lib/Travel/Status/DE/HAFAS/StopFinder.pm b/lib/Travel/Status/DE/HAFAS/StopFinder.pm
new file mode 100644
index 0000000..6984098
--- /dev/null
+++ b/lib/Travel/Status/DE/HAFAS/StopFinder.pm
@@ -0,0 +1,205 @@
+package Travel::Status::DE::HAFAS::StopFinder;
+
+use strict;
+use warnings;
+use 5.010;
+use utf8;
+
+no if $] >= 5.018, warnings => 'experimental::smartmatch';
+
+use Carp qw(confess);
+use JSON;
+use LWP::UserAgent;
+
+our $VERSION = '1.05';
+
+sub new {
+	my ( $obj, %conf ) = @_;
+
+	my $lang = $conf{language} // 'd';
+
+	my %lwp_options = %{ $conf{lwp_options} // { timeout => 10 } };
+
+	my $ua = LWP::UserAgent->new(%lwp_options);
+
+	$ua->env_proxy;
+
+	my $reply;
+
+	if ( not $conf{input} ) {
+		confess('You need to specify an input value');
+	}
+	if ( not $conf{url} ) {
+		confess('You need to specify a URL');
+	}
+
+	my $ref = {
+		developer_mode => $conf{developer_mode},
+		post           => {
+			getstop             => 1,
+			REQ0JourneyStopsS0A => 255,
+			REQ0JourneyStopsS0G => $conf{input},
+		},
+	};
+
+	bless( $ref, $obj );
+
+	my $url = $conf{url} . "/${lang}n";
+
+	$reply = $ua->post( $url, $ref->{post} );
+
+	if ( $reply->is_error ) {
+		$ref->{errstr} = $reply->status_line;
+		return $ref;
+	}
+
+	$ref->{raw_reply} = $reply->content;
+
+	$ref->{raw_reply} =~ s{ ^ SLs [.] sls = }{}x;
+	$ref->{raw_reply} =~ s{ ; SLs [.] showSuggestion [(] [)] ; $ }{}x;
+
+	if ( $ref->{developer_mode} ) {
+		say $ref->{raw_reply};
+	}
+
+	$ref->{json} = from_json( $ref->{raw_reply} );
+
+	return $ref;
+}
+
+sub errstr {
+	my ($self) = @_;
+
+	return $self->{errstr};
+}
+
+sub results {
+	my ($self) = @_;
+
+	$self->{results} = [];
+
+	for my $result ( @{ $self->{json}->{suggestions} } ) {
+		if ( $result->{typeStr} eq '[Bhf/Hst]' ) {
+			push(
+				@{ $self->{results} },
+				{
+					name => $result->{value},
+					id   => $result->{extId}
+				}
+			);
+		}
+	}
+
+	return @{ $self->{results} };
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Travel::Status::DE::HAFAS::StopFinder - Interface to HAFAS-based online stop
+finder services
+
+=head1 SYNOPSIS
+
+	use Travel::Status::DE::HAFAS::StopFinder;
+
+	my $sf = Travel::Status::DE::HAFAS::StopFinder->new(
+		url => 'http://reiseauskunft.bahn.de/bin/ajax-getstop.exe',
+		input => 'Borbeck',
+	);
+
+	if (my $err = $sf->errstr) {
+		die("Request error: ${err}\n");
+	}
+
+	for my $candidate ($sf->results) {
+		printf("%s (%s)\n", $candidate->{name}, $candidate->{id});
+	}
+
+=head1 VERSION
+
+version 1.05
+
+=head1 DESCRIPTION
+
+Travel::Status::DE::HAFAS::StopFinder is an interface to the stop finder
+service of HAFAS based arrival/departure monitors, for instance the one
+available at L<http://reiseauskunft.bahn.de/bin/ajax-getstop.exe/dn>.
+
+It takes a string (usually a location or station name) and reports all
+stations and stops which are lexically similar to it.
+
+=head1 METHODS
+
+=over
+
+=item my $stopfinder = Travel::Status::DE::HAFAS::StopFinder->new(I<%opts>)
+
+Looks up stops as specified by I<opts> and teruns a new
+Travel::Status::DE::HAFAS::StopFinder element with the results.  Dies if the
+wrong I<opts> were passed.
+
+Supported I<opts> are:
+
+=over
+
+=item B<input> => I<string>
+
+string to look up, e.g. "Borbeck" or "Koeln Bonn Flughafen". Mandatory.
+
+=item B<url> => I<url>
+
+Base I<url> of the stop finder service, without the language and mode
+suffix ("/dn" and similar). Mandatory. See Travel::Status::DE::HAFAS(3pm)'s
+B<get_services> method for a list of URLs.
+
+=back
+
+=item $status->errstr
+
+In case of an error in the HTTP request, returns a string describing it.  If
+no error occurred, returns undef.
+
+=item $status->results
+
+Returns a list of stop candidates. Each list element is a hash reference. The
+hash keys are B<id> (IBNR) and B<name> (stop name). Both can be used as input
+for the Travel::Status::DE::HAFAS(3pm) constructor.
+
+If no matching results were found or the parser / http request failed, returns
+the empty list.
+
+=back
+
+=head1 DIAGNOSTICS
+
+None.
+
+=head1 DEPENDENCIES
+
+=over
+
+=item * LWP::UserAgent(3pm)
+
+=item * JSON(3pm)
+
+=back
+
+=head1 BUGS AND LIMITATIONS
+
+Unknown.
+
+=head1 SEE ALSO
+
+Travel::Status::DE::HAFAS(3pm).
+
+=head1 AUTHOR
+
+Copyright (C) 2015 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt>
+
+=head1 LICENSE
+
+This module is licensed under the same terms as Perl itself.