diff options
Diffstat (limited to 'lib/Travel/Status/DE')
-rw-r--r-- | lib/Travel/Status/DE/HAFAS.pm | 31 | ||||
-rw-r--r-- | lib/Travel/Status/DE/HAFAS/Journey.pm | 12 | ||||
-rw-r--r-- | lib/Travel/Status/DE/HAFAS/Location.pm | 127 | ||||
-rw-r--r-- | lib/Travel/Status/DE/HAFAS/Stop.pm | 102 |
4 files changed, 183 insertions, 89 deletions
diff --git a/lib/Travel/Status/DE/HAFAS.pm b/lib/Travel/Status/DE/HAFAS.pm index d5c2730..c085f4a 100644 --- a/lib/Travel/Status/DE/HAFAS.pm +++ b/lib/Travel/Status/DE/HAFAS.pm @@ -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} // [] }; + 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. diff --git a/lib/Travel/Status/DE/HAFAS/Journey.pm b/lib/Travel/Status/DE/HAFAS/Journey.pm index 37f8262..62e089a 100644 --- a/lib/Travel/Status/DE/HAFAS/Journey.pm +++ b/lib/Travel/Status/DE/HAFAS/Journey.pm @@ -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}; diff --git a/lib/Travel/Status/DE/HAFAS/Location.pm b/lib/Travel/Status/DE/HAFAS/Location.pm new file mode 100644 index 0000000..288836b --- /dev/null +++ b/lib/Travel/Status/DE/HAFAS/Location.pm @@ -0,0 +1,127 @@ +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. diff --git a/lib/Travel/Status/DE/HAFAS/Stop.pm b/lib/Travel/Status/DE/HAFAS/Stop.pm index 2ea73b5..a8da9c3 100644 --- a/lib/Travel/Status/DE/HAFAS/Stop.pm +++ b/lib/Travel/Status/DE/HAFAS/Stop.pm @@ -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} ); - } + $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. |