package Travel::Status::DE::HAFAS::StopFinder; use strict; use warnings; use 5.014; use utf8; no if $] >= 5.018, warnings => 'experimental::smartmatch'; use Carp qw(confess); use Encode qw(decode); use JSON; use LWP::UserAgent; our $VERSION = '4.04'; # {{{ Constructors sub new { my ( $obj, %conf ) = @_; my $lang = $conf{language} // 'd'; my $ua = $conf{ua}; if ( not $ua and not $conf{async} ) { my %lwp_options = %{ $conf{lwp_options} // { timeout => 10 } }; $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 ); if ( $conf{async} ) { return $ref; } 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->decoded_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 new_p { my ( $obj, %conf ) = @_; my $promise = $conf{promise}->new; if ( not $conf{input} ) { return $promise->reject('You need to specify an input value'); } if ( not $conf{url} ) { return $promise->reject('You need to specify a URL'); } my $self = $obj->new( %conf, async => 1 ); $self->{promise} = $conf{promise}; my $lang = $conf{language} // 'd'; my $url = $conf{url} . "/${lang}n"; $conf{user_agent}->post_p( $url, form => $self->{post} )->then( sub { my ($tx) = @_; if ( my $err = $tx->error ) { $promise->reject( "POST $url returned HTTP $err->{code} $err->{message}"); return; } my $content = $tx->res->body; $self->{raw_reply} = $content; $self->{raw_reply} =~ s{ ^ SLs [.] sls = }{}x; $self->{raw_reply} =~ s{ ; SLs [.] showSuggestion [(] [)] ; $ }{}x; if ( $self->{developer_mode} ) { say $self->{raw_reply}; } $self->{json} = from_json( $self->{raw_reply} ); $promise->resolve( $self->results ); return; } )->catch( sub { my ($err) = @_; $promise->reject($err); return; } )->wait; return $promise; } # }}} 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 => decode( 'iso-8859-15', $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 => 'https://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 4.04 =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. 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 and teruns a new Travel::Status::DE::HAFAS::StopFinder element with the results. Dies if the wrong I were passed. Supported I are: =over =item B => I string to look up, e.g. "Borbeck" or "Koeln Bonn Flughafen". Mandatory. =item B => I Base I of the stop finder service, without the language and mode suffix ("/dn" and similar). Mandatory. See Travel::Status::DE::HAFAS(3pm)'s B method for a list of URLs. =item B => I Set language. Accepted arguments are Beutsch, Bnglish, Btalian and B (dutch), depending on the used service. It is unknown if this option has any effect. =item B => I<\%hashref> Passed on to C<< LWP::UserAgent->new >>. Defaults to C<< { timeout => 10 } >>, you can use an empty hashref to override it. =back =item my $stopfinder_p = Travel::Status::DE::HAFAS::StopFinder->new_p(I<%opt>) Return a promise that resolves into a list of Travel::Status::DE::HAFAS::StopFinder results ($stopfinder->results) on success and rejects with an error message ($stopfinder->errstr) on failure. In addition to the arguments of B, the following mandatory arguments must be set. =over =item B => I Promises implementation to use for internal promises as well as B return value. Recommended: Mojo::Promise(3pm). =item B => I User agent instance to use for asynchronous requests. The object must implement a B function. Recommended: Mojo::UserAgent(3pm). =back =item $stopfinder->errstr In case of an error in the HTTP request, returns a string describing it. If no error occurred, returns undef. =item $stopfinder->results Returns a list of stop candidates. Each list element is a hash reference. The hash keys are B (IBNR / UIC station code) and B (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-2017 by Daniel Friesel Ederf@finalrewind.orgE =head1 LICENSE This module is licensed under the same terms as Perl itself.