#!/usr/bin/env perl ## Copyright © 2009 by Daniel Friesel ## License: WTFPL use strict; use warnings; use 5.010; use encoding 'utf8'; use Getopt::Long; use WWW::Mechanize; my $firsturl = 'http://efa.vrr.de/vrr/XSLT_TRIP_REQUEST2?language=de&itdLPxx_transpCompany=vrr'; my $posturl = 'http://efa.vrr.de/vrr/XSLT_TRIP_REQUEST2'; my $content; my %post; my $www = WWW::Mechanize->new( autocheck => 1, ); my $offer = 0; my $i = 0; my $raw; my $cons; my $groupsize = 8; my $offset; my @from; my @to; my ($time, $time_for); my $date; my $debug = 0; $post{type_origin} = 'stop'; $post{type_destination} = 'stop'; GetOptions( 'from=s{2}' => \@from, 'to=s{2}' => \@to, 'time=s' => \$time, 'date=s' => \$date, 'debug' => \$debug, 'time-for=s' => \$time_for, ); unless (@to == 2 and @from == 2) { print STDERR "Usage: efa --from --to [other options]\n"; exit(1); } @post{'place_origin','name_origin'} = @from; @post{'place_destination','name_destination'} = @to; if ($time) { @post{'itdTimeHour','itdTimeMinute'} = split(/:/, $time); } if ($date) { @post{'itdDateDay','itdDateMonth','itdDateYear'} = split(/\./, $date); } if ($time_for) { given ($time_for) { when('arrival') {$post{itdTripDateTimeDepArr} = 'arr'} when('departure') {$post{itdTripDateTimeDepArr} = 'dep'} } } $www->get($firsturl); $www->submit_form( form_name => 'jp', fields => \%post, ); $content = $www->content; foreach(split(/ \d+\. Fahrt<\/span>/, $content)) { unless ($offer) { $offer++; next; } foreach(split(/\n/)) { if (/(?[^<]+)<\/span>/) { push(@{$raw->[$offer-1]}, $+{content}); } } $offer++; } if ($debug) { print STDERR "custom post values used in query:\n"; foreach(keys(%post)) { print STDERR " $_ => $post{$_}\n"; } print STDERR "\nraw response:\n"; foreach(@$raw) { print STDERR "---\n"; foreach(@$_) { print STDERR "$_\n"; } } } for ($offer = 0; exists($raw->[$offer]); $offer++) { for ($i = 0; @{$raw->[$offer]} >= (($i+1) * $groupsize); $i++) { $offset = $i * $groupsize; # If the first field is not a time we've got some additional information. # Sadly, this script does not parse it yet, so it's ignored until ($raw->[$offer]->[$offset] =~ /^\d+:\d+$/) { splice(@{$raw->[$offer]}, $offset, 1) or last; } $cons->[$offer]->[$i] = { deptime => $raw->[$offer]->[$offset], dep => $raw->[$offer]->[$offset+1], depstop => $raw->[$offer]->[$offset+2], deptrain => $raw->[$offer]->[$offset+3], depdest => $raw->[$offer]->[$offset+7], arrtime => $raw->[$offer]->[$offset+4], arr => $raw->[$offer]->[$offset+5], arrstop => $raw->[$offer]->[$offset+6], }; } } foreach (@$cons) { foreach (@$_) { printf( "%-5s %-2s %-30s %-20s %s\n%-5s %-2s %-30s\n\n", $_->{deptime}, $_->{dep}, $_->{depstop}, $_->{deptrain}, $_->{depdest}, $_->{arrtime}, $_->{arr}, $_->{arrstop} ); } print "------\n\n"; } __END__ =head1 NAME efa - unofficial efa.vrr.de command line cleant =head1 SYNOPSIS B B<--from> I I B<--to> I I [ I ] =head1 DESCRIPTION B is a command line client for the L web interface. It sends the specified information to the online form and displays the results =head1 OPTIONS =over =item B<--from> I I (mandatory) Departure place =item B<--to> I I (mandatory) Arrival place =item B<--debug> Display debug information (additional post requests sent to the site, raw items received from the site) =item B<--time> I:I Journey start/end time =item B<--time-for> B|B Define whether the time means time of departure (default) or time of arrival =item B<--date> I
.I.I Journey date =back