diff options
| -rw-r--r-- | Changelog | 2 | ||||
| -rwxr-xr-x | bin/db-ris | 5 | ||||
| -rw-r--r-- | lib/Travel/Status/DE/DeutscheBahn.pm | 37 |
3 files changed, 39 insertions, 5 deletions
@@ -3,6 +3,8 @@ git HEAD [Travel::Status::DE::DeutscheBahn] * Fix ->results returning duplicate connections when accessed more than one time + * new: Only die when encountering wrong options, set ->error otherwise + * Adds new ->errstr accessor to check for request errors Travel::Status::DE::DeutscheBahn 0.04 - Wed Jul 13 2011 @@ -84,6 +84,11 @@ sub display_result { return; } +if ( my $err = $status->errstr ) { + say "Request error: ${err}"; + exit 2; +} + for my $d ( $status->results() ) { my @via; diff --git a/lib/Travel/Status/DE/DeutscheBahn.pm b/lib/Travel/Status/DE/DeutscheBahn.pm index baf1fe2..136cf51 100644 --- a/lib/Travel/Status/DE/DeutscheBahn.pm +++ b/lib/Travel/Status/DE/DeutscheBahn.pm @@ -54,12 +54,14 @@ sub new { } } + bless( $ref, $obj ); + $reply = $ua->post( 'http://reiseauskunft.bahn.de/bin/bhftafel.exe/dn?rt=1', $ref->{post} ); if ( $reply->is_error ) { - my $errstr = $reply->status_line(); - confess("Could not submit POST request: ${errstr}"); + $ref->{errstr} = $reply->status_line(); + return $ref; } $ref->{html} = $reply->content; @@ -71,7 +73,7 @@ sub new { suppress_warnings => 1, ); - return bless( $ref, $obj ); + return $ref; } sub new_from_html { @@ -94,6 +96,12 @@ sub new_from_html { return bless( $ref, $obj ); } +sub errstr { + my ($self) = @_; + + return $self->{errstr}; +} + sub results { my ($self) = @_; my $mode = $self->{post}->{boardType}; @@ -116,6 +124,9 @@ sub results { if ( defined $self->{results} ) { return @{ $self->{results} }; } + if ( not defined $self->{tree} ) { + return; + } for my $tr ( @{ $self->{tree}->findnodes($xp_element) } ) { @@ -194,6 +205,10 @@ arrival/departure monitor station => 'Essen Hbf', ); + if (my $err = $status->errstr) { + die("Request error: ${err}\n"); + } + for my $departure ($status->results) { printf( "At %s: %s to %s from platform %s\n", @@ -224,7 +239,11 @@ unspecified). =item my $status = Travel::Status::DE::DeutscheBahn->new(I<%opts>) -Returns a new Travel::Status::DE::DeutscheBahn element. Supported I<opts> are: +Requests the departures/arrivals as specified by I<opts> and returns a new +Travel::Status::DE::DeutscheBahn element with the results. Dies if the wrong +I<opts> were passed. + +Supported I<opts> are: =over @@ -259,11 +278,19 @@ By default, the following are shown: ice, ic_ec, d, nv, s. =back -=item $status->results() +=item $status->error + +In case of an error in the HTTP request, returns a string describing it. If +no error occured, returns undef. + +=item $status->results Returns a list of arrivals/departures. Each list element is a Travel::Status::DE::DeutscheBahn::Result(3pm) object. +If no matching results were found or the parser / http request failed, returns +undef. + =back =head1 DIAGNOSTICS |