summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.gitignore10
-rw-r--r--Build.PL22
-rw-r--r--README24
-rwxr-xr-xbin/efa-m139
-rw-r--r--lib/Travel/Status/DE/VRR.pm155
-rw-r--r--lib/Travel/Status/DE/VRR/Result.pm74
6 files changed, 424 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..189304f
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,10 @@
+/_build
+/Build
+/blib
+/cover_db
+/MANIFEST
+/MANIFEST.bak
+/MANIFEST.SKIP
+/MANIFEST.SKIP.bak
+/MYMETA.yml
+/MYMETA.json
diff --git a/Build.PL b/Build.PL
new file mode 100644
index 0000000..094b2d3
--- /dev/null
+++ b/Build.PL
@@ -0,0 +1,22 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Module::Build;
+
+Module::Build->new(
+
+ build_requires => {
+ 'Test::More' => 0,
+ 'Test::Pod' => 0,
+ },
+ module_name => 'Travel::Status::DE::VRR',
+ license => 'unrestricted',
+ requires => {
+ 'perl' => '5.10.1',
+ 'Getopt::Long' => 0,
+ 'XML::LibXML' => 0,
+ },
+ sign => 1,
+
+)->create_build_script();
diff --git a/README b/README
new file mode 100644
index 0000000..f4b1577
--- /dev/null
+++ b/README
@@ -0,0 +1,24 @@
+Travel::Status::DE::VRR - ??
+-----------------------------------------------
+
+* <http://finalrewind.org/projects/Travel-Status-DE-VRR/>
+
+
+Dependencies
+------------
+
+ * perl version 5.10.1 or newer
+ * XML::LibXML
+
+
+Installation
+------------
+
+$ perl Build.PL
+$ ./Build
+$ sudo ./Build install
+
+See also the Module::Build documentation.
+
+You can then run 'man Travel::Status::DE::VRR'.
+This distribution also ships the script 'efa-m', see 'man efa-m'.
diff --git a/bin/efa-m b/bin/efa-m
new file mode 100755
index 0000000..f031e81
--- /dev/null
+++ b/bin/efa-m
@@ -0,0 +1,139 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use 5.010;
+
+our $VERSION = '0.00';
+
+use Getopt::Long qw(:config no_ignore_case);
+use List::Util qw(max);
+use Travel::Status::DE::VRR;
+
+my ( $date, $time );
+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,
+
+) or show_help(1);
+
+if (@ARGV != 2) {
+ show_help(1);
+}
+
+my ($place, $station) = @ARGV;
+
+my $status = Travel::Status::DE::VRR->new(
+ date => $date,
+ place => $place,
+ name => $station,
+ time => $time,
+);
+
+sub show_help {
+ my ($code) = @_;
+
+ print "Usage: efa-m [-d <dd.mm.yyyy>] [-t <hh:mm>] <city> <station>\n"
+ . "See also: man efa-m\n";
+
+ exit $code;
+}
+
+sub show_version {
+ say "efa-m version ${VERSION}";
+
+ exit 0;
+}
+
+sub display_result {
+ my (@lines) = @_;
+
+ my @line_length;
+
+ if ( not @lines ) {
+ die("Nothing to show\n");
+ }
+
+ for my $i ( 0 .. 3 ) {
+ $line_length[$i] = max map { length( $_->[$i] ) } @lines;
+ }
+
+ for my $line (@lines) {
+ printf(
+ join( q{ }, ( map { "%-${_}s" } @line_length ) ) . "\n",
+ @{$line}[ 0 .. 3 ]
+ );
+ }
+
+ return;
+}
+
+for my $d ( $status->results ) {
+
+ push(
+ @output,
+ [
+ $d->time,
+ $d->platform,
+ $d->line,
+ $d->destination,
+ ]
+ );
+}
+
+display_result(@output);
+
+__END__
+
+=head1 NAME
+
+=head1 SYNOPSIS
+
+=head1 VERSION
+
+version 0.00
+
+=head1 DESCRIPTION
+
+=head1 OPTIONS
+
+=over
+
+=item B<-V>, B<--version>
+
+Show version information.
+
+=back
+
+=head1 EXIT STATUS
+
+=head1 CONFIGURATION
+
+None.
+
+=head1 DEPENDENCIES
+
+=over
+
+=item * Class::Accessor(3pm)
+
+=item * XML::LibXML(3pm)
+
+=item * WWW::Mechanize(3pm)
+
+=back
+
+=head1 BUGS AND LIMITATIONS
+
+=head1 AUTHOR
+
+Copyright (C) 2011 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt>
+
+=head1 LICENSE
+
+This program is licensed under the same terms as Perl itself.
diff --git a/lib/Travel/Status/DE/VRR.pm b/lib/Travel/Status/DE/VRR.pm
new file mode 100644
index 0000000..8bb1f6d
--- /dev/null
+++ b/lib/Travel/Status/DE/VRR.pm
@@ -0,0 +1,155 @@
+package Travel::Status::DE::VRR;
+
+use strict;
+use warnings;
+use 5.010;
+
+our $VERSION = '0.00';
+
+use Travel::Status::DE::VRR::Result;
+use WWW::Mechanize;
+use XML::LibXML;
+
+sub new {
+ my ( $class, %opt ) = @_;
+
+ my $mech = WWW::Mechanize->new();
+ my @now = localtime( time() );
+
+ my $self = {
+ post => {
+ 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',
+ },
+ };
+
+ $mech->post( 'http://efa.vrr.de/vrr/XSLT_DM_REQUEST', $self->{post} );
+
+ if ( $mech->response->is_error ) {
+ die( $mech->response->status_line );
+ }
+
+ my $form = $mech->form_number(1);
+
+ for my $input ( $form->find_input( 'dmLineSelection', 'option' ) ) {
+ $input->check();
+ }
+
+ $mech->click('submitButton');
+
+ if ( $mech->response->is_error ) {
+ die( $mech->response->status_line );
+ }
+
+ $self->{html} = $mech->response->decoded_content;
+
+ $self->{tree} = XML::LibXML->load_html(
+ string => $self->{html},
+ recover => 2,
+ suppress_errors => 1,
+ suppress_warnings => 1,
+ );
+
+ return bless( $self, $class );
+}
+
+sub results {
+ my ($self) = @_;
+ my @results;
+
+ my $xp_element = XML::LibXML::XPathExpression->new(
+ '//td[@colspan="3"]/table/tr[starts-with(@class,"bgColor")]');
+
+ my @parts = (
+ ['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;
+ $platform =~ s{ ^ \S+ \s }{}x;
+ push(@results, Travel::Status::DE::VRR::Result->new(
+ time => $time,
+ platform => $platform,
+ line => $line,
+ destination => $dest,
+ ));
+ }
+
+ return @results;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Travel::Status::DE::VRR - inofficial VRR departure monitor
+
+=head1 SYNOPSIS
+
+=head1 VERSION
+
+version
+
+=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
+
+This module is licensed under the same terms as Perl itself.
diff --git a/lib/Travel/Status/DE/VRR/Result.pm b/lib/Travel/Status/DE/VRR/Result.pm
new file mode 100644
index 0000000..a61a9d2
--- /dev/null
+++ b/lib/Travel/Status/DE/VRR/Result.pm
@@ -0,0 +1,74 @@
+package Travel::Status::DE::VRR::Result;
+
+use strict;
+use warnings;
+use 5.010;
+
+use parent 'Class::Accessor';
+
+our $VERSION = '0.00';
+
+Travel::Status::DE::VRR::Result->mk_ro_accessors(
+ qw(destination time platform line));
+
+sub new {
+ my ( $obj, %conf ) = @_;
+
+ my $ref = \%conf;
+
+ return bless( $ref, $obj );
+}
+1;
+
+__END__
+
+=head1 NAME
+
+Travel::Status::DE::VRR::Result - Information about a single
+departure received by Travel::Status::DE::VRR
+
+=head1 SYNOPSIS
+
+=head1 VERSION
+
+version 0.00
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head2 ACCESSORS
+
+=over
+
+=back
+
+=head2 INTERNAL
+
+=over
+
+=back
+
+=head1 DIAGNOSTICS
+
+None.
+
+=head1 DEPENDENCIES
+
+=over
+
+=item Class::Accessor(3pm)
+
+=back
+
+=head1 BUGS AND LIMITATIONS
+
+=head1 SEE ALSO
+
+=head1 AUTHOR
+
+Copyright (C) 2011 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt>
+
+=head1 LICENSE
+
+This module is licensed under the same terms as Perl itself.
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-22 04:04:02 +0000