diff options
-rwxr-xr-x | bin/efa-m | 30 | ||||
-rw-r--r-- | lib/Travel/Status/DE/VRR.pm | 105 |
2 files changed, 66 insertions, 69 deletions
@@ -15,24 +15,24 @@ my @output; binmode( STDOUT, ':encoding(utf-8)' ); GetOptions( - 'd|date=s' => \$date, - 'h|help' => sub { show_help(0) }, - 't|time=s' => \$time, - 'V|version' => \&show_version, + 'd|date=s' => \$date, + 'h|help' => sub { show_help(0) }, + 't|time=s' => \$time, + 'V|version' => \&show_version, ) or show_help(1); -if (@ARGV != 2) { +if ( @ARGV != 2 ) { show_help(1); } -my ($place, $station) = @ARGV; +my ( $place, $station ) = @ARGV; my $status = Travel::Status::DE::VRR->new( - date => $date, - place => $place, - name => $station, - time => $time, + date => $date, + place => $place, + name => $station, + time => $time, ); sub show_help { @@ -75,15 +75,7 @@ sub display_result { for my $d ( $status->results ) { - push( - @output, - [ - $d->time, - $d->platform, - $d->line, - $d->destination, - ] - ); + push( @output, [ $d->time, $d->platform, $d->line, $d->destination, ] ); } display_result(@output); diff --git a/lib/Travel/Status/DE/VRR.pm b/lib/Travel/Status/DE/VRR.pm index cbb1262..ae1ef44 100644 --- a/lib/Travel/Status/DE/VRR.pm +++ b/lib/Travel/Status/DE/VRR.pm @@ -6,6 +6,7 @@ use 5.010; our $VERSION = '0.00'; +use Carp qw(confess); use Travel::Status::DE::VRR::Result; use WWW::Mechanize; use XML::LibXML; @@ -14,47 +15,47 @@ sub new { my ( $class, %opt ) = @_; my $mech = WWW::Mechanize->new(); - my @now = localtime( time() ); + my @now = localtime( time() ); my $self = { post => { - command => q{}, + command => q{}, deleteAssignedStops_dm => '1', - help => 'Hilfe', - itdDateDay => $now[3], - itdDateMonth => $now[4] + 1, - itdDateYear => $now[5] + 1900, - itdLPxx_id_dm => ':dm', - itdLPxx_mapState_dm => q{}, - itdLPxx_mdvMap2_dm => q{}, - itdLPxx_mdvMap_dm => '3406199:401077:NAV3', - itdLPxx_transpCompany => 'vrr', - itdLPxx_view => q{}, - itdTimeHour => $now[2], - itdTimeMinute => $now[1], - language => 'de', - nameInfo_dm => 'invalid', - nameState_dm => 'empty', - name_dm => $opt{name}, - placeInfo_dm => 'invalid', - placeState_dm => 'empty', - place_dm => $opt{place}, - ptOptionsActive => '1', - requestID => '0', - reset => 'neue Anfrage', - sessionID => '0', - submitButton => 'anfordern', - typeInfo_dm => 'invalid', - type_dm => 'stop', - useProxFootSearch => '0', - useRealtime => '1', + help => 'Hilfe', + itdDateDay => $now[3], + itdDateMonth => $now[4] + 1, + itdDateYear => $now[5] + 1900, + itdLPxx_id_dm => ':dm', + itdLPxx_mapState_dm => q{}, + itdLPxx_mdvMap2_dm => q{}, + itdLPxx_mdvMap_dm => '3406199:401077:NAV3', + itdLPxx_transpCompany => 'vrr', + itdLPxx_view => q{}, + itdTimeHour => $now[2], + itdTimeMinute => $now[1], + language => 'de', + nameInfo_dm => 'invalid', + nameState_dm => 'empty', + name_dm => $opt{name}, + placeInfo_dm => 'invalid', + placeState_dm => 'empty', + place_dm => $opt{place}, + ptOptionsActive => '1', + requestID => '0', + reset => 'neue Anfrage', + sessionID => '0', + submitButton => 'anfordern', + typeInfo_dm => 'invalid', + type_dm => 'stop', + useProxFootSearch => '0', + useRealtime => '1', }, }; $mech->post( 'http://efa.vrr.de/vrr/XSLT_DM_REQUEST', $self->{post} ); if ( $mech->response->is_error ) { - die( $mech->response->status_line ); + confess( $mech->response->status_line ); } my $form = $mech->form_number(1); @@ -66,15 +67,15 @@ sub new { $mech->click('submitButton'); if ( $mech->response->is_error ) { - die( $mech->response->status_line ); + confess( $mech->response->status_line ); } $self->{html} = $mech->response->decoded_content; $self->{tree} = XML::LibXML->load_html( - string => $self->{html}, - recover => 2, - suppress_errors => 1, + string => $self->{html}, + recover => 2, + suppress_errors => 1, suppress_warnings => 1, ); @@ -89,23 +90,27 @@ sub results { '//td[@colspan="3"]/table/tr[starts-with(@class,"bgColor")]'); my @parts = ( - ['time', './td[2]'], - ['platform', './td[3]'], - ['line', './td[5]'], - ['dest', './td[7]'], + [ 'time', './td[2]' ], + [ 'platform', './td[3]' ], + [ 'line', './td[5]' ], + [ 'dest', './td[7]' ], ); - @parts = map { [ $_->[0], XML::LibXML::XPathExpression->new($_->[1]) ] } - @parts; - - for my $tr ($self->{tree}->findnodes($xp_element) ) { - my ($time, $platform, $line, $dest) = map { ($tr->findnodes($_->[1]))[0]->textContent } @parts; - push(@results, Travel::Status::DE::VRR::Result->new( - time => $time, - platform => $platform, - line => $line, - destination => $dest, - )); + @parts = map { [ $_->[0], XML::LibXML::XPathExpression->new( $_->[1] ) ] } + @parts; + + for my $tr ( $self->{tree}->findnodes($xp_element) ) { + my ( $time, $platform, $line, $dest ) + = map { ( $tr->findnodes( $_->[1] ) )[0]->textContent } @parts; + push( + @results, + Travel::Status::DE::VRR::Result->new( + time => $time, + platform => $platform, + line => $line, + destination => $dest, + ) + ); } return @results; |