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

Move location-specific data and accessors to ...::HAFAS::Location 

This is a breaking change that affects the accessors of ...::Stop and the
return type of $hafas->results in locationSearch and geoSearch mode
parent f9678526

bin/hafas-m

+1 −1
Original line number Diff line number Diff line
@@ -323,7 +323,7 @@ elsif ( $opt{journey} ) { 
			$stop->delay ? sprintf( '(%+d)', $stop->delay ) : q{},

			display_occupancy( $stop->load->{FIRST} ),

			display_occupancy( $stop->load->{SECOND} ),

			$stop->name,

			$stop->loc->name,

			$stop->direction ? sprintf( '  → %s', $stop->direction ) : q{}

		);

	}

lib/Travel/Status/DE/HAFAS.pm

+16 −15
Original line number Diff line number Diff line
@@ -14,11 +14,11 @@ use Digest::MD5 qw(md5_hex); 
use Encode      qw(decode encode);

use JSON;

use LWP::UserAgent;

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

use Travel::Status::DE::HAFAS::Location;

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;

use Travel::Status::DE::HAFAS::Stop;



our $VERSION = '4.19';
@@ -654,19 +654,14 @@ sub parse_search { 
		return $self;

	}



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

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



	if ( $self->{raw_json}{svcResL}[0]{res}{match} ) {

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

	}



	for my $loc (@locL) {

		push(

			@{ $self->{results} },

			Travel::Status::DE::HAFAS::Stop->new( loc => $loc )

		);

	}

	@{ $self->{results} }

	  = map { Travel::Status::DE::HAFAS::Location->new( loc => $_ ) } @locL;



	return $self;

}
@@ -678,7 +673,8 @@ sub parse_journey { 
		return $self;

	}



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

	my @locL = map { Travel::Status::DE::HAFAS::Location->new( loc => $_ ) }

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

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

	my @polyline;
@@ -688,13 +684,14 @@ sub parse_journey { 
			my $poly = $polyline[ $ref->{ppIdx} ];

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



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

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

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

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

		}

	}



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

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

		locL     => \@locL,

		journey  => $journey,

		polyline => \@polyline,

		hafas    => $self,
@@ -712,6 +709,8 @@ sub parse_board { 
		return $self;

	}



	my @locL = map { Travel::Status::DE::HAFAS::Location->new( loc => $_ ) }

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

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



	for my $result (@jnyL) {
@@ -719,6 +718,7 @@ sub parse_board { 
			@{ $self->{results} },

			Travel::Status::DE::HAFAS::Journey->new(

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

				locL    => \@locL,

				journey => $result,

				hafas   => $self,

			)
@@ -791,6 +791,7 @@ sub station { 
		return $self->{station_info};

	}



	# no need to use Location instances here

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



	my %prefc_by_loc;
@@ -1054,8 +1055,8 @@ describing it. If no error occurred, returns undef. 


=item $status->results (geoSearch, locationSearch)



Returns a list of stations. Each list element is a

Travel::Status::DE::HAFAS::Stop(3pm) object.

Returns a list of stop locations. Each list element is a

Travel::Status::DE::HAFAS::Location(3pm) object.



If no matching results were found or the parser / http request failed, returns

an empty list.

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

+6 −6
Original line number Diff line number Diff line
@@ -26,7 +26,6 @@ Travel::Status::DE::HAFAS::Journey->mk_ro_accessors( 
sub new {

	my ( $obj, %opt ) = @_;



	my @locL  = @{ $opt{common}{locL}  // [] };

	my @prodL = @{ $opt{common}{prodL} // [] };

	my @opL   = @{ $opt{common}{opL}   // [] };

	my @icoL  = @{ $opt{common}{icoL}  // [] };
@@ -34,6 +33,7 @@ sub new { 
	my @remL  = @{ $opt{common}{remL}  // [] };

	my @himL  = @{ $opt{common}{himL}  // [] };



	my $locL    = $opt{locL};

	my $hafas   = $opt{hafas};

	my $journey = $opt{journey};
@@ -108,7 +108,7 @@ sub new { 
	my @stops;

	my $route_end;

	for my $stop ( @{ $journey->{stopL} // [] } ) {

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

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



		push(

			@stops,
@@ -122,7 +122,7 @@ sub new { 
			}

		);



		$route_end = $loc->{name};

		$route_end = $loc->name;

	}



	if ( $journey->{stbStop} ) {
@@ -164,14 +164,14 @@ sub new { 
		}

	}

	else {

		$ref->{route_start} = $stops[0]{loc}{name};

		$ref->{route_start} = $stops[0]{loc}->name;

	}



	bless( $ref, $obj );



	if ( $journey->{stbStop} ) {

		$ref->{station}     = $locL[ $journey->{stbStop}{locX} ]->{name};

		$ref->{station_eva} = 0 + $locL[ $journey->{stbStop}{locX} ]->{extId};

		$ref->{station}        = $locL->[ $journey->{stbStop}{locX} ]->name;

		$ref->{station_eva}    = 0 + $locL->[ $journey->{stbStop}{locX} ]->eva;

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

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

		$ref->{platform}       = $ref->{rt_platform} // $ref->{sched_platform};

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

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



use strict;

use warnings;

use 5.014;



use parent 'Class::Accessor';



our $VERSION = '4.19';



Travel::Status::DE::HAFAS::Location->mk_ro_accessors(

	qw(lid type name eva state lat lon distance_m weight));



sub new {

	my ( $obj, %opt ) = @_;



	my $loc = $opt{loc};



	my $ref = {

		lid   => $loc->{lid},

		type  => $loc->{type},

		name  => $loc->{name},

		eva   => 0 + $loc->{extId},

		state => $loc->{state},

		lat   => $loc->{crd}{y} * 1e-6,

		lon   => $loc->{crd}{x} * 1e-6,



		# only for geosearch requests

		weight     => $loc->{wt},

		distance_m => $loc->{dist},

	};



	bless( $ref, $obj );



	return $ref;

}



sub TO_JSON {

	my ($self) = @_;



	my $ret = { %{$self} };



	return $ret;

}



1;



__END__



=head1 NAME



Travel::Status::DE::HAFAS::Location - A single public transit location



=head1 SYNOPSIS



	printf("Destination: %s  (%8d)\n", $location->name, $location->eva);



=head1 VERSION



version 4.19



=head1 DESCRIPTION



Travel::Status::DE::HAFAS::Location describes a HAFAS location that either

belongs to a location (e.g. on a journey's route) or has been returned as part of

a location search request.



=head1 METHODS



=head2 ACCESSORS



=over



=item $location->name



Location name, e.g. "Essen Hbf" or "Unter den Linden/B75, Tostedt".



=item $location->eva



EVA ID, e.g. 8000080.



=item $location->lat



Location latitude (WGS-84)



=item $location->lon



Location longitude (WGS-84)



=item $location->distance_m (geoSearch)



Distance in meters between the requested coordinates and this location.



=item $location->weight (geoSearch, locationSearch)



Weight / Relevance / Importance of this location using an unknown metric.

Higher values indicate more relevant locations.



=back



=head1 DIAGNOSTICS



None.



=head1 DEPENDENCIES



=over



=item Class::Accessor(3pm)



=back



=head1 BUGS AND LIMITATIONS



None known.



=head1 SEE ALSO



Travel::Routing::DE::HAFAS(3pm).



=head1 AUTHOR



Copyright (C) 2023 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt>



=head1 LICENSE



This module is licensed under the same terms as Perl itself.

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

+34 −68
Original line number Diff line number Diff line
@@ -11,7 +11,7 @@ use parent 'Class::Accessor'; 
our $VERSION = '4.19';



Travel::Status::DE::HAFAS::Stop->mk_ro_accessors(

	qw(eva name lat lon distance_m weight

	qw(loc

	  rt_arr sched_arr arr arr_delay arr_cancelled

	  rt_dep sched_dep dep dep_delay dep_cancelled

	  delay direction
@@ -25,28 +25,14 @@ Travel::Status::DE::HAFAS::Stop->mk_ro_accessors( 
sub new {

	my ( $obj, %opt ) = @_;



	my $loc = $opt{loc};

	my $ref = {

		eva        => $loc->{extId} + 0,

		name       => $loc->{name},

		lat        => $loc->{crd}{y} * 1e-6,

		lon        => $loc->{crd}{x} * 1e-6,

		weight     => $loc->{wt},

		distance_m => $loc->{dist},

		loc => $opt{loc},

	};



	if ( $opt{extra} ) {

		while ( my ( $k, $v ) = each %{ $opt{extra} } ) {

			$ref->{$k} = $v;

		}

	}



	bless( $ref, $obj );



	if ( $opt{stop} ) {

	$ref->parse_stop( $opt{stop}, $opt{common}, $opt{date},

		$opt{datetime_ref}, $opt{strp_obj} );

	}



	return $ref;

}
@@ -162,12 +148,13 @@ Travel::Status::DE::HAFAS::Stop - Information about a HAFAS stop. 


=head1 SYNOPSIS



	# in geoSearch mode

	for my $stop ($status->results) {

	# in journey mode

	for my $stop ($journey->route) {

		printf(

			"%5.1f km  %8d  %s\n",

			$result->distance_m * 1e-3,

			$result->eva, $result->name

			%5s -> %5s %s\n",

			$stop->arr ? $stop->arr->strftime('%H:%M') : '--:--',

			$stop->dep ? $stop->dep->strftime('%H:%M') : '--:--',

			$stop->loc->name

		);

	}
@@ -177,11 +164,10 @@ version 4.19 


=head1 DESCRIPTION



Travel::Status::DE::HAFAS::Stop describes a HAFAS stop. It may be part of a

journey or part of a geoSearch / locationSearch request.



Journey-, geoSearch- and locationSearch-specific accessors are annotated

accordingly and return undef in other contexts.

Travel::Status::DE::HAFAS::Stop describes a

Travel::Status::DE::HAFAS::Journey(3pm)'s stop at a given

Travel::Status::DE::HAFAS::Location(3pm) with arrival/departure time,

platform, etc.



=head1 METHODS
@@ -189,96 +175,76 @@ accordingly and return undef in other contexts. 


=over



=item $stop->name



Stop name, e.g. "Essen Hbf" or "Unter den Linden/B75, Tostedt".



=item $stop->eva



EVA ID, e.g. 8000080.



=item $stop->lat



Stop latitude (WGS-84)



=item $stop->lon



Stop longitude (WGS-84)



=item $stop->distance_m (geoSearch)



Distance in meters between the requested coordinates and this stop.



=item $stop->weight

=item $stop->loc



Weight / Relevance / Importance of this stop using an unknown metric.

Higher values indicate more relevant stops.

Travel::Status::DE::HAFAS::Location(3pm) dinstance describing stop name, EVA

ID, et cetera.



=item $stop->rt_arr (journey)

=item $stop->rt_arr



DateTime object for actual arrival.



=item $stop->sched_arr (journey)

=item $stop->sched_arr



DateTime object for scheduled arrival.



=item $stop->arr (journey)

=item $stop->arr



DateTime object for actual or scheduled arrival.



=item $stop->arr_delay (journey)

=item $stop->arr_delay



Arrival delay in minutes.



=item $stop->arr_cancelled (journey)

=item $stop->arr_cancelled



Arrival is cancelled.



=item $stop->rt_dep (journey)

=item $stop->rt_dep



DateTime object for actual departure.



=item $stop->sched_dep (journey)

=item $stop->sched_dep



DateTime object for scheduled departure.



=item $stop->dep (journey)

=item $stop->dep



DateTIme object for actual or scheduled departure.



=item $stop->dep_delay (journey)

=item $stop->dep_delay



Departure delay in minutes.



=item $stop->dep_cancelled (journey)

=item $stop->dep_cancelled



Departure is cancelled.



=item $stop->delay (journey)

=item $stop->delay



Departure or arrival delay in minutes.



=item $stop->direction (journey)

=item $stop->direction



Direction signage from this stop on, undef if unchanged.



=item $stop->rt_platform (journey)

=item $stop->rt_platform



Actual platform.



=item $stop->sched_platform (journey)

=item $stop->sched_platform



Scheduled platform.



=item $stop->platform (journey)

=item $stop->platform



Actual or scheduled platform.



=item $stop->is_changed_platform (journey)

=item $stop->is_changed_platform



True if real-time and scheduled platform disagree.



=item $stop->load (journey)

=item $stop->load



Expected utilization / passenger load from this stop on.