summaryrefslogtreecommitdiff
path: root/lib/Travel/Status/DE/HAFAS
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Travel/Status/DE/HAFAS')
-rw-r--r--lib/Travel/Status/DE/HAFAS/StopFinder.pm205
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.