Commit 4da3a72b authored by Birte Kristina Friesel's avatar Birte Kristina Friesel
Browse files

Introducing ::Route and ::Route::Part

parent 194c4ee9

Build.PL

+1 −0
Original line number Diff line number Diff line
@@ -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,

Changelog

+1 −0
Original line number Diff line number Diff line
@@ -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

bin/efa

+9 −7
Original line number Diff line number Diff line
@@ -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";

	}

}

lib/Net/Travel/DE/VRR.pm

+13 −12
Original line number Diff line number Diff line
@@ -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

lib/Net/Travel/DE/VRR/Route.pm

0 → 100644
+72 −0
Original line number Diff line number Diff line 
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.