Commit ed8f38f2 authored by Birte Kristina Friesel's avatar Birte Kristina Friesel
Browse files

Try Exception::Class

parent 7e214984

Build.PL

+2 −1
Original line number Diff line number Diff line
@@ -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,

bin/efa

+89 −19
Original line number Diff line number Diff line
@@ -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,7 +146,8 @@ if ( defined $opt->{'ignore-info'} and length( $opt->{'ignore-info'} ) == 0 ) { 
	$opt->{'ignore-info'} = undef;

}



$efa = Travel::Routing::DE::VRR->new(

$efa = eval {

	Travel::Routing::DE::VRR->new(

		origin      => [ @from, $from_type ],

		destination => [ @to,   $to_type ],

		via => ( @via ? [ @via, $via_type ] : undef ),
@@ -96,9 +163,12 @@ $efa = Travel::Routing::DE::VRR->new( 
		use_near_stops        => $opt->{proximity},

		walk_speed            => $opt->{'walk-speed'},

		max_interchanges      => $opt->{'max-change'},



		lwp_options => { timeout => $opt->{timeout} },

	);

};



$efa->submit( timeout => $opt->{'timeout'} );

check_for_error($@);



my @routes = $efa->routes();

lib/Travel/Routing/DE/VRR.pm

+79 −21
Original line number Diff line number Diff line
@@ -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;

t/20-vrr.t

+2 −0
Original line number Diff line number Diff line
@@ -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];