diff options
| -rw-r--r-- | Build.PL | 1 | ||||
| -rw-r--r-- | Changelog | 1 | ||||
| -rwxr-xr-x | bin/efa | 16 | ||||
| -rw-r--r-- | lib/Net/Travel/DE/VRR.pm | 25 | ||||
| -rw-r--r-- | lib/Net/Travel/DE/VRR/Route.pm | 72 | ||||
| -rw-r--r-- | lib/Net/Travel/DE/VRR/Route/Part.pm | 69 |
6 files changed, 165 insertions, 19 deletions
@@ -15,6 +15,7 @@ my %opts = ( module_name => 'Net::Travel::DE::VRR', license => 'unrestricted', requires => { + 'Class::Accessor' => 0, 'perl' => '5.10.0', 'Getopt::Long' => 0, 'XML::LibXML' => 0, @@ -2,6 +2,7 @@ git HEAD * Remove --foo-type options, use --to city type:stop etc. instead * Introducing Net::Travel::DE::VRR + * New dependency: Class::Accessor efa 1.3 - Sun Jun 6 2010 @@ -100,12 +100,12 @@ $efa->submit( timeout => $opt->{'timeout'} ); $efa->parse(); -my @connections = $efa->connections(); +my @routes = $efa->routes(); -for my $i ( 0 .. $#connections ) { - for my $c ( @{ $connections[$i] } ) { +for my $i ( 0 .. $#routes ) { + for my $c ( $routes[$i]->parts() ) { - for my $extra ( @{ $c->{'extra'} } ) { + for my $extra ( $c->extra() ) { if ( not( length $ignore_info and $extra =~ /$ignore_info/i ) ) { say "# $extra"; @@ -114,11 +114,13 @@ for my $i ( 0 .. $#connections ) { printf( "%-5s ab %-30s %-20s %s\n%-5s an %-30s\n\n", - $c->{'dep_time'}, $c->{'dep_stop'}, $c->{'train_line'}, - $c->{'train_dest'}, $c->{'arr_time'}, $c->{'arr_stop'}, + $c->get( + qw(dep_time dep_stop train_line train_dest arr_time + arr_stop) + ), ); } - if ( $i != $#connections ) { + if ( $i != $#routes ) { print "------\n\n"; } } diff --git a/lib/Net/Travel/DE/VRR.pm b/lib/Net/Travel/DE/VRR.pm index 5d330fd..7948194 100644 --- a/lib/Net/Travel/DE/VRR.pm +++ b/lib/Net/Travel/DE/VRR.pm @@ -5,6 +5,7 @@ use warnings; use 5.010; use Carp qw(confess); +use Net::Travel::DE::VRR::Route; use LWP::UserAgent; use XML::LibXML; @@ -319,7 +320,7 @@ sub parse_initial { sub parse_pretty { my ($con_parts) = @_; - my $elements; + my @elements; my @next_extra; for my $con ( @{$con_parts} ) { @@ -370,10 +371,10 @@ sub parse_pretty { $hash->{arr_stop} = $con->[6]; $hash->{train_dest} = $con->[7]; - push( @{$elements}, $hash ); + push( @elements, $hash ); } - return $elements; + return Net::Travel::DE::VRR::Route->new(@elements); } sub new { @@ -416,7 +417,7 @@ sub parse { my $raw_cons = parse_initial($tree); for my $raw_con ( @{$raw_cons} ) { - push( @{ $self->{connections} }, parse_pretty($raw_con) ); + push( @{ $self->{routes} }, parse_pretty($raw_con) ); } $self->{tree} = $tree; @@ -470,10 +471,10 @@ sub check_no_connections { return; } -sub connections { +sub routes { my ($self) = @_; - return @{ $self->{connections} }; + return @{ $self->{routes} }; } 1; @@ -496,12 +497,12 @@ Net::Travel::DE::VRR - inofficial interface to the efa.vrr.de German itinerary s $efa->submit(); $efa->parse(); - for my $con ($efa->connections()) { - for my $c (@{$con}) { + for my $route ($efa->routes()) { + for my $part (@{$route}) { printf( - "%-5s ab %-30s %-20s %s\n%-5s an %-30s\n\n",, - @{$c}{'dep_time', 'dep_stop', 'train_line', 'train_dest'}, - @{$c}{'arr_time', 'arr_stop'}, + "%-5s ab %-30s %-20s %s\n%-5s an %-30s\n\n", + $part->dep_time, $part->dep_stop, $part->train_line, + $part->train_dest, $part->arr_time, $part->arr_stop, ); } print "\n\n"; @@ -602,7 +603,7 @@ I<%opts> is passed on to LWP::UserAgent->new(%opts). Parse the B<efa.vrr.de> reply. returns a true value on success. -=item $efa->connections() +=item $efa->routes() Returns an array of connection elements. Each connection element is an arrayref of connection part, and each connecton part is a hash containing the diff --git a/lib/Net/Travel/DE/VRR/Route.pm b/lib/Net/Travel/DE/VRR/Route.pm new file mode 100644 index 0000000..1b71097 --- /dev/null +++ b/lib/Net/Travel/DE/VRR/Route.pm @@ -0,0 +1,72 @@ +package Net::Travel::DE::VRR::Route; + +use strict; +use warnings; +use 5.010; + +use Net::Travel::DE::VRR::Route::Part; + +our $VERSION = '1.3'; + +sub new { + my ( $obj, @parts ) = @_; + + my $ref = {}; + + for my $part (@parts) { + push( + @{ $ref->{parts} }, + Net::Travel::DE::VRR::Route::Part->new( %{$part} ) + ); + } + + return bless( $ref, $obj ); +} + +sub parts { + my ($self) = @_; + + return @{ $self->{parts} }; +} + +1; + +__END__ + +=head1 NAME + +Net::Travel::DE::VRR::Route - Single route (connection) between two points + +=head1 SYNOPSIS + +=head1 VERSION + +version 1.3 + +=head1 DESCRIPTION + +=head1 METHODS + +=over + +=back + +=head1 DIAGNOSTICS + +=head1 DEPENDENCIES + +=over + +=back + +=head1 BUGS AND LIMITATIONS + +=head1 SEE ALSO + +=head1 AUTHOR + +Copyright (C) 2011 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt> + +=head1 LICENSE + + 0. You just DO WHAT THE FUCK YOU WANT TO. diff --git a/lib/Net/Travel/DE/VRR/Route/Part.pm b/lib/Net/Travel/DE/VRR/Route/Part.pm new file mode 100644 index 0000000..d512fbb --- /dev/null +++ b/lib/Net/Travel/DE/VRR/Route/Part.pm @@ -0,0 +1,69 @@ +package Net::Travel::DE::VRR::Route::Part; + +use strict; +use warnings; +use 5.010; + +use parent 'Class::Accessor'; + +our $VERSION = '1.3'; + +Net::Travel::DE::VRR::Route::Part->mk_ro_accessors( + qw(arr_stop arr_time dep_stop dep_time train_line train_dest)); + +sub new { + my ( $obj, %conf ) = @_; + + my $ref = \%conf; + + return bless( $ref, $obj ); +} + +sub extra { + my ($self) = @_; + + return @{ $self->{extra} // [] }; +} + +1; + +__END__ + +=head1 NAME + +Net::Travel::DE::VRR::Route::Part - Describes one connection between two +points, without interchanges + +=head1 SYNOPSIS + +=head1 VERSION + +version 0.3 + +=head1 DESCRIPTION + +=head1 METHODS + +=over + +=back + +=head1 DIAGNOSTICS + +=head1 DEPENDENCIES + +=over + +=back + +=head1 BUGS AND LIMITATIONS + +=head1 SEE ALSO + +=head1 AUTHOR + +Copyright (C) 2011 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt> + +=head1 LICENSE + + 0. You just DO WHAT THE FUCK YOU WANT TO. |