diff options
| -rw-r--r-- | Build.PL | 3 | ||||
| -rwxr-xr-x | bin/efa | 108 | ||||
| -rw-r--r-- | lib/Travel/Routing/DE/VRR.pm | 100 | ||||
| -rw-r--r-- | t/20-vrr.t | 2 |
4 files changed, 172 insertions, 41 deletions
@@ -15,8 +15,9 @@ Module::Build->new( module_name => 'Travel::Routing::DE::VRR', license => 'unrestricted', requires => { - 'Class::Accessor' => 0, 'perl' => '5.10.0', + 'Class::Accessor' => 0, + 'Exception::Class' => 0, 'Getopt::Long' => 0, 'XML::LibXML' => 0, 'WWW::Mechanize' => 0, @@ -7,6 +7,7 @@ use warnings; use 5.010; use Travel::Routing::DE::VRR; +use Exception::Class; use Getopt::Long qw/:config no_ignore_case/; our $VERSION = '1.3'; @@ -25,6 +26,71 @@ my $opt = { binmode( STDOUT, ':encoding(utf-8)' ); binmode( STDERR, ':encoding(utf-8)' ); +sub handle_efa_exception { + my ($e) = @_; + + if ( $e->isa('Travel::Routing::DE::VRR::Exception::Setup') ) { + if ( $e->message ) { + printf STDERR ( "Error: %s (option '%s'): %s\n", $e->description, + $e->message ); + } + else { + printf STDERR ( + "Error: %s (option '%s', got '%s', want '%s')\n", + $e->description, $e->option, $e->have, $e->want + ); + } + + exit 1; + } + if ( $e->isa('Travel::Routing::DE::VRR::Exception::Net') ) { + printf STDERR ( "Error: %s: %s\n", $e->description, + $e->http_errstr->as_string ); + exit 2; + } + if ( $e->isa('Travel::Routing::DE::VRR::Exception::NoData') ) { + printf STDERR ( 'Error: %s', $e->description ); + exit 3; + } + if ( $e->isa('Travel::Routing::DE::VRR::Exception::Ambiguous') ) { + printf STDERR ( + "Error: %s for key %s. Specify one of %s\n", + $e->description, $e->post_key, $e->possibilities + ); + exit 4; + } + if ( $e->isa('Travel::Routing::DE::VRR::Exception::NoConnections') ) { + printf STDERR ( "Error: %s: %s\n", $e->description, $e->error ); + exit 5; + } + + printf STDERR ( "Uncatched exception: %s\n%s", ref($e), $e->trace ); + exit 10; +} + +sub check_for_error { + my ($eval_error) = @_; + + if ( not defined $efa ) { + if ( $eval_error + and ref($eval_error) =~ m{^Travel::Routing::DE::VRR::Exception}x ) + { + handle_efa_exception($eval_error); + } + elsif ($eval_error) { + printf STDERR + "Unknown Travel::Routing::DE::VRR error:\n${eval_error}"; + exit 10; + } + else { + say STDERR 'Travel::Routing::DE::VRR failed to return an object'; + exit 10; + } + } + + return; +} + #<<< GetOptions( $opt, @@ -80,25 +146,29 @@ if ( defined $opt->{'ignore-info'} and length( $opt->{'ignore-info'} ) == 0 ) { $opt->{'ignore-info'} = undef; } -$efa = Travel::Routing::DE::VRR->new( - origin => [ @from, $from_type ], - destination => [ @to, $to_type ], - via => ( @via ? [ @via, $via_type ] : undef ), - - arrival_time => $opt->{arrive}, - departure_time => $opt->{depart} // $opt->{time}, - date => $opt->{date}, - exclude => $opt->{exclude}, - train_type => $opt->{include}, - with_bike => $opt->{bike}, - - select_interchange_by => $opt->{prefer}, - use_near_stops => $opt->{proximity}, - walk_speed => $opt->{'walk-speed'}, - max_interchanges => $opt->{'max-change'}, -); - -$efa->submit( timeout => $opt->{'timeout'} ); +$efa = eval { + Travel::Routing::DE::VRR->new( + origin => [ @from, $from_type ], + destination => [ @to, $to_type ], + via => ( @via ? [ @via, $via_type ] : undef ), + + arrival_time => $opt->{arrive}, + departure_time => $opt->{depart} // $opt->{time}, + date => $opt->{date}, + exclude => $opt->{exclude}, + train_type => $opt->{include}, + with_bike => $opt->{bike}, + + select_interchange_by => $opt->{prefer}, + use_near_stops => $opt->{proximity}, + walk_speed => $opt->{'walk-speed'}, + max_interchanges => $opt->{'max-change'}, + + lwp_options => { timeout => $opt->{timeout} }, + ); +}; + +check_for_error($@); my @routes = $efa->routes(); diff --git a/lib/Travel/Routing/DE/VRR.pm b/lib/Travel/Routing/DE/VRR.pm index 695feaa..73de3d1 100644 --- a/lib/Travel/Routing/DE/VRR.pm +++ b/lib/Travel/Routing/DE/VRR.pm @@ -4,11 +4,29 @@ use strict; use warnings; use 5.010; -use Carp qw(confess); use Travel::Routing::DE::VRR::Route; use LWP::UserAgent; use XML::LibXML; +use Exception::Class ( + 'Travel::Routing::DE::VRR::Exception::Setup' => { + description => 'invalid argument on setup', + fields => [ 'option', 'have', 'want' ], + }, + 'Travel::Routing::DE::VRR::Exception::Net' => { + description => 'could not submit POST request', + fields => 'http_response', + }, + 'Travel::Routing::DE::VRR::Exception::NoData' => + { description => 'got no data to parse', }, + 'Travel::Routing::DE::VRR::Exception::Ambiguous' => { + description => 'ambiguous input', + fields => [ 'post_key', 'possibilities' ], + }, + 'Travel::Routing::DE::VRR::Exception::NoConnections' => + { description => 'got no connections', }, +); + our $VERSION = '1.3'; sub set_time { @@ -25,11 +43,18 @@ sub set_time { $time = $conf{arrival_time}; } else { - confess('time: Specify either departure_time or arrival_time'); + Travel::Routing::DE::VRR::Exception::Setup->throw( + option => 'time', + error => 'Specify either departure_time or arrival_time' + ); } if ( $time !~ / ^ [0-2]? \d : [0-5]? \d $ /x ) { - confess("time: must match HH:MM - '${time}'"); + Travel::Routing::DE::VRR::Exception::Setup->throw( + option => 'time', + have => $time, + want => 'HH:MM', + ); } @{ $self->{post} }{ 'itdTimeHour', 'itdTimeMinute' } = split( /:/, $time ); @@ -54,12 +79,22 @@ sub date { my ( $day, $month, $year ) = split( /[.]/, $date ); - if ( not defined $day or not length($day) or $day < 1 or $day > 31 ) { - confess("date: invalid day, must match DD.MM[.[YYYY]] - '${date}'"); - } - if ( not defined $month or not length($month) or $month < 1 or $month > 12 ) + if ( + not( defined $day + and length($day) + and $day >= 1 + and $day <= 31 + and defined $month + and length($month) + and $month >= 1 + and $month <= 12 ) + ) { - confess("date: invalid month, must match DD.MM[.[YYYY]] - '${date}'"); + Travel::Routing::DE::VRR::Exception::Setup->throw( + option => 'date', + have => $date, + want => 'DD.MM[.[YYYY]]' + ); } if ( not defined $year or not length($year) ) { @@ -89,7 +124,11 @@ sub exclude { } } if ( not $ok ) { - confess("exclude: Unsupported type '${exclude_type}'"); + Travel::Routing::DE::VRR::Exception::Setup->throw( + option => 'exclude', + have => $exclude_type, + want => join( ' / ', @mapping ), + ); } } @@ -112,8 +151,10 @@ sub select_interchange_by { when ('waittime') { $self->{post}->{routeType} = 'LEASTINTERCHANGE' } when ('distance') { $self->{post}->{routeType} = 'LEASTWALKING' } default { - confess( -"select_interchange_by: Must be speed/waittime/distance: '${prefer}'" + Travel::Routing::DE::VRR::Exception::Setup->throw( + option => 'select_interchange_by', + have => $prefer, + want => 'speed / waittime / distance', ); } } @@ -129,7 +170,11 @@ sub train_type { when ('ic') { $self->{post}->{lineRestriction} = 401 } when ('ice') { $self->{post}->{lineRestriction} = 400 } default { - confess("train_type: Must be local/ic/ice: '${include}'"); + Travel::Routing::DE::VRR::Exception::Setup->throw( + option => 'train_type', + have => $include, + want => 'local / ic / ice', + ); } } @@ -151,7 +196,11 @@ sub walk_speed { $self->{post}->{changeSpeed} = $walk_speed; } else { - confess("walk_speed: Must be normal/fast/slow: '${walk_speed}'"); + Travel::Routing::DE::VRR::Exception::Setup->throw( + option => 'walk_speed', + have => $walk_speed, + want => 'normal / fast / slow', + ); } return; @@ -169,7 +218,10 @@ sub place { my ( $self, $which, $place, $stop, $type ) = @_; if ( not( $place and $stop ) ) { - confess('place: Need >= three elements'); + Travel::Routing::DE::VRR::Exception::Setup->throw( + option => 'place', + error => 'Need >= three elements' + ); } $type //= 'stop'; @@ -435,22 +487,24 @@ sub new { $ref->create_post(); + if ( not( defined $conf{submit} and $conf{submit} == 0 ) ) { + $ref->submit( %{ $conf{lwp_options} } ); + } + return $ref; } sub submit { my ( $self, %conf ) = @_; - $conf{autocheck} = 1; - $self->{ua} = LWP::UserAgent->new(%conf); my $response = $self->{ua} ->post( 'http://efa.vrr.de/vrr/XSLT_TRIP_REQUEST2', $self->{post} ); if ( $response->is_error ) { - my $errstr = $response->status_line; - confess("Could not submit POST request: ${errstr}"); + Travel::Routing::DE::VRR::Exception::Net->throw( + http_response => $response, ); } # XXX (workaround) @@ -478,7 +532,7 @@ sub parse { $self->check_no_connections(); if ( @{$raw_cons} == 0 ) { - confess('Got no data to parse'); + Travel::Routing::DE::VRR::Exception::NoData->throw(); } return 1; @@ -501,7 +555,10 @@ sub check_ambiguous { } my $err_text = join( q{, }, @possible ); - confess("Ambiguous input for '${post_key}': '${err_text}'"); + Travel::Routing::DE::VRR::Exception::Ambiguous->throw( + post_key => $post_key, + possibilities => $err_text, + ); } return; @@ -518,7 +575,8 @@ sub check_no_connections { if ($err_node) { my $text = $err_node->parentNode()->parentNode()->textContent(); - confess("Got no connections: '${text}'"); + Travel::Routing::DE::VRR::Exception::NoConnections->throw( + error => $text, ); } return; @@ -14,6 +14,8 @@ sub efa_conf { my $ret = { origin => ['Essen', 'HBf'], destination => ['Koeln', 'HBf'], + lwp_options => {}, + submit => 0, }; foreach my $p (@_) { $ret->{$p->[0]} = $p->[1]; |