initial commit

/_build

/Build

/blib

/cover_db

/MANIFEST

/MANIFEST.bak

/MANIFEST.SKIP

/MANIFEST.SKIP.bak

/MYMETA.yml

/MYMETA.json

#!/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();

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'.

#!/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.

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.