Unverified Commit 239820ff authored by Birte Kristina Friesel's avatar Birte Kristina Friesel
Browse files

HAFAS->new: support 'journey' requests. polylines and route still WiP

parent 2a4e8410

lib/Travel/Status/DE/HAFAS.pm

+115 −49
Original line number Diff line number Diff line
@@ -17,6 +17,7 @@ use List::Util qw(any); 
use LWP::UserAgent;

use POSIX qw(strftime);

use Travel::Status::DE::HAFAS::Message;

use Travel::Status::DE::HAFAS::Polyline qw(decode_polyline);

use Travel::Status::DE::HAFAS::Journey;

use Travel::Status::DE::HAFAS::StopFinder;
@@ -186,7 +187,7 @@ sub new { 
		$ua->env_proxy;

	}



	if ( not $conf{station} ) {

	if ( not $conf{station} and not $conf{journey} ) {

		confess('You need to specify a station');

	}
@@ -215,6 +216,24 @@ sub new { 


	bless( $self, $obj );



	my $req;



	if ( $conf{journey} ) {

		$req = {

			svcReqL => [

				{

					meth => 'JourneyDetails',

					req  => {

						jid         => $conf{journey}{id},

						name        => $conf{journey}{name} // '0',

						getPolyline => $conf{with_polyline} ? \1 : \0,

					},

				}

			],

			%{ $hafas_instance{$service}{request} }

		};

	}

	else {

		my $date = ( $conf{datetime} // $now )->strftime('%Y%m%d');

		my $time = ( $conf{datetime} // $now )->strftime('%H%M%S');
@@ -246,9 +265,10 @@ sub new { 
			}

		}



	my $req = {

		$req = {

			svcReqL => [

				{

					meth => 'StationBoard',

					req  => {

						type     => ( $conf{arrivals} ? 'ARR' : 'DEP' ),

						stbLoc   => { lid => $lid },
@@ -257,14 +277,19 @@ sub new { 
						date     => $date,

						time     => $time,

						dur      => -1,

					jnyFltrL =>

					  [ { type => "PROD", mode => "INC", value => $mot_mask } ]

				},

				meth => 'StationBoard'

						jnyFltrL => [

							{

								type  => "PROD",

								mode  => "INC",

								value => $mot_mask

							}

						]

					},

				},

			],

			%{ $hafas_instance{$service}{request} }

		};

	}



	my $json = $self->{json} = JSON->new->utf8;
@@ -318,7 +343,18 @@ sub new { 
	}



	$self->check_mgate;

	$self->parse_mgate;



	$self->{strptime_obj} //= DateTime::Format::Strptime->new(

		pattern   => '%Y%m%dT%H%M%S',

		time_zone => 'Europe/Berlin',

	);



	if ( $conf{journey} ) {

		$self->parse_journey;

	}

	else {

		$self->parse_board;

	}



	return $self;

}
@@ -339,7 +375,7 @@ sub new_p { 
			my ($content) = @_;

			$self->{raw_json} = $self->{json}->decode($content);

			$self->check_mgate;

			$self->parse_mgate;

			$self->parse_board;

			$promise->resolve($self);

			return;

		}
@@ -549,19 +585,44 @@ sub messages { 
	return @{ $self->{messages} };

}



sub parse_mgate {

sub parse_journey {

	my ($self) = @_;



	$self->{results} = [];



	if ( $self->{errstr} ) {

		return $self;

	}



	$self->{strptime_obj} //= DateTime::Format::Strptime->new(

		pattern   => '%Y%m%dT%H%M%S',

		time_zone => 'Europe/Berlin',

	my @locL    = @{ $self->{raw_json}{svcResL}[0]{res}{common}{locL} // [] };

	my $journey = $self->{raw_json}{svcResL}[0]{res}{journey};

	my @polyline;



	if ( $journey->{poly} ) {

		@polyline = decode_polyline( $journey->{poly}{crdEncYX} );

		for my $ref ( @{ $journey->{poly}{ppLocRefL} // [] } ) {

			my $poly = $polyline[ $ref->{ppIdx} ];

			my $loc  = $locL[ $ref->{locX} ];



			$poly->{name} = $loc->{name};

			$poly->{eva}  = $loc->{extId} + 0;

		}

	}



	$self->{result} = Travel::Status::DE::HAFAS::Journey->new(

		common   => $self->{raw_json}{svcResL}[0]{res}{common},

		journey  => $journey,

		polyline => \@polyline,

		hafas    => $self,

	);

}



sub parse_board {

	my ($self) = @_;



	$self->{results} = [];



	if ( $self->{errstr} ) {

		return $self;

	}



	my @jnyL = @{ $self->{raw_json}{svcResL}[0]{res}{jnyL} // [] };
@@ -583,6 +644,11 @@ sub results { 
	return @{ $self->{results} };

}



sub result {

	my ($self) = @_;

	return $self->{result};

}



# static

sub get_services {

	my @services;

lib/Travel/Status/DE/HAFAS/Journey.pm

+46 −37
Original line number Diff line number Diff line
@@ -29,26 +29,10 @@ sub new { 
	my $journey = $opt{journey};



	my $date = $journey->{date};

	my $time_s

	  = $journey->{stbStop}{ $hafas->{arrivals} ? 'aTimeS' : 'dTimeS' };

	my $time_r

	  = $journey->{stbStop}{ $hafas->{arrivals} ? 'aTimeR' : 'dTimeR' };

	my $datetime_s

	  = $hafas->{strptime_obj}->parse_datetime("${date}T${time_s}");

	my $datetime_r

	  = $time_r

	  ? $hafas->{strptime_obj}->parse_datetime("${date}T${time_r}")

	  : undef;

	my $delay

	  = $datetime_r

	  ? ( $datetime_r->epoch - $datetime_s->epoch ) / 60

	  : undef;



	my $destination  = $journey->{dirTxt};

	my $is_cancelled = $journey->{isCncl};

	my $jid          = $journey->{jid};

	my $platform     = $journey->{stbStop}{dPlatfS};

	my $new_platform = $journey->{stbStop}{dPlatfR};



	my $product    = $prodL[ $journey->{prodX} ];

	my $train      = $product->{prodCtx}{name};
@@ -108,33 +92,58 @@ sub new { 
	shift @stops;



	my $ref = {

		sched_datetime => $datetime_s,

		rt_datetime    => $datetime_r,

		datetime       => $datetime_r // $datetime_s,

		datetime_now => $hafas->{now},

		delay          => $delay,

		is_cancelled => $is_cancelled,

		train        => $train,

		operator     => $operator,

		route_end    => $destination,

		platform       => $platform,

		new_platform   => $new_platform,

		messages     => \@messages,

		route        => \@stops,

	};



	bless( $ref, $obj );



	if ( $journey->{stbStop} ) {

		$ref->{platform}     = $journey->{stbStop}{dPlatfS};

		$ref->{new_platform} = $journey->{stbStop}{dPlatfR};



		my $time_s

		  = $journey->{stbStop}{ $hafas->{arrivals} ? 'aTimeS' : 'dTimeS' };

		my $time_r

		  = $journey->{stbStop}{ $hafas->{arrivals} ? 'aTimeR' : 'dTimeR' };



		my $datetime_s

		  = $hafas->{strptime_obj}->parse_datetime("${date}T${time_s}");

		my $datetime_r

		  = $time_r

		  ? $hafas->{strptime_obj}->parse_datetime("${date}T${time_r}")

		  : undef;



		my $delay

		  = $datetime_r

		  ? ( $datetime_r->epoch - $datetime_s->epoch ) / 60

		  : undef;



		$ref->{sched_datetime} = $datetime_s;

		$ref->{rt_datetime}    = $datetime_r;

		$ref->{datetime}       = $datetime_r // $datetime_s;

		$ref->{delay}          = $delay;



		if ( $ref->{delay} ) {

			$ref->{datetime} = $ref->{rt_datetime};

		}

		else {

			$ref->{datetime} = $ref->{sched_datetime};

		}



		$ref->{date}       = $ref->{datetime}->strftime('%d.%m.%Y');

		$ref->{time}       = $ref->{datetime}->strftime('%H:%M');

		$ref->{sched_date} = $ref->{sched_datetime}->strftime('%d.%m.%Y');

		$ref->{sched_time} = $ref->{sched_datetime}->strftime('%H:%M');

	}

	if ( $opt{polyline} ) {

		$ref->{polyline} = $opt{polyline};

	}



	return $ref;

}

lib/Travel/Status/DE/HAFAS/Polyline.pm

0 → 100644
+96 −0
Original line number Diff line number Diff line 
package Travel::Status::DE::HAFAS::Polyline;



use strict;

use warnings;

use 5.014;



# Adapted from code by Slaven Rezic

#

# Copyright (C) 2009,2010,2012,2017,2018 Slaven Rezic. All rights reserved.

# This package is free software; you can redistribute it and/or

# modify it under the same terms as Perl itself.

#

# Mail: slaven@rezic.de

# WWW:  http://www.rezic.de/eserte/



use parent 'Exporter';

our @EXPORT_OK = qw(decode_polyline);

our $VERSION   = '0.06';



# Translated this php script

# <http://unitstep.net/blog/2008/08/02/decoding-google-maps-encoded-polylines-using-php/>

# to perl

sub decode_polyline {

	my ($encoded) = @_;



	my $length = length $encoded;

	my $index  = 0;

	my @points;

	my $lat = 0;

	my $lng = 0;



	while ( $index < $length ) {



		# The encoded polyline consists of a latitude value followed

		# by a longitude value. They should always come in pairs. Read

		# the latitude value first.

		for my $val ( \$lat, \$lng ) {

			my $shift  = 0;

			my $result = 0;



			# Temporary variable to hold each ASCII byte.

			my $b;

			do {

				# The `ord(substr($encoded, $index++))` statement returns

				# the ASCII code for the character at $index. Subtract 63

				# to get the original value. (63 was added to ensure

				# proper ASCII characters are displayed in the encoded

				# polyline string, which is `human` readable)

				$b = ord( substr( $encoded, $index++, 1 ) ) - 63;



				# AND the bits of the byte with 0x1f to get the original

				# 5-bit `chunk. Then left shift the bits by the required

				# amount, which increases by 5 bits each time. OR the

				# value into $results, which sums up the individual 5-bit

				# chunks into the original value. Since the 5-bit chunks

				# were reversed in order during encoding, reading them in

				# this way ensures proper summation.

				$result |= ( $b & 0x1f ) << $shift;

				$shift += 5;

			  }



			  # Continue while the read byte is >= 0x20 since the last

			  # `chunk` was not OR'd with 0x20 during the conversion

			  # process. (Signals the end)

			  while ( $b >= 0x20 );



			# see last paragraph of "Integer Arithmetic" in perlop.pod

			use integer;



        # Check if negative, and convert. (All negative values have the last bit

        # set)

			my $dtmp

			  = ( ( $result & 1 ) ? ~( $result >> 1 ) : ( $result >> 1 ) );



			# Compute actual latitude (resp. longitude) since value is

			# offset from previous value.

			$$val += $dtmp;

		}



		# The actual latitude and longitude values were multiplied by

		# 1e5 before encoding so that they could be converted to a 32-bit

		# integer representation. (With a decimal accuracy of 5 places)

		# Convert back to original values.

		push(

			@points,

			{

				lat => $lat * 1e-5,

				lon => $lng * 1e-5

			}

		);

	}



	return @points;

}



1;