From 2a4e84102440154d0320778bad870046b226d703 Mon Sep 17 00:00:00 2001 From: Daniel Friesel Date: Sun, 9 Oct 2022 08:37:20 +0200 Subject: rename Result to Journey (in line with HAFAS naming convention) --- lib/Travel/Status/DE/HAFAS.pm | 8 +- lib/Travel/Status/DE/HAFAS/Journey.pm | 432 ++++++++++++++++++++++++++++++++++ lib/Travel/Status/DE/HAFAS/Result.pm | 432 ---------------------------------- 3 files changed, 436 insertions(+), 436 deletions(-) create mode 100644 lib/Travel/Status/DE/HAFAS/Journey.pm delete mode 100644 lib/Travel/Status/DE/HAFAS/Result.pm diff --git a/lib/Travel/Status/DE/HAFAS.pm b/lib/Travel/Status/DE/HAFAS.pm index 04d4e81..769ff39 100644 --- a/lib/Travel/Status/DE/HAFAS.pm +++ b/lib/Travel/Status/DE/HAFAS.pm @@ -17,7 +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::Result; +use Travel::Status::DE::HAFAS::Journey; use Travel::Status::DE::HAFAS::StopFinder; our $VERSION = '3.01'; @@ -568,7 +568,7 @@ sub parse_mgate { for my $result (@jnyL) { push( @{ $self->{results} }, - Travel::Status::DE::HAFAS::Result->new( + Travel::Status::DE::HAFAS::Journey->new( common => $self->{raw_json}{svcResL}[0]{res}{common}, journey => $result, hafas => $self, @@ -738,7 +738,7 @@ describing it. If no error occurred, returns undef. =item $status->results Returns a list of arrivals/departures. Each list element is a -Travel::Status::DE::HAFAS::Result(3pm) object. +Travel::Status::DE::HAFAS::Journey(3pm) object. If no matching results were found or the parser / http request failed, returns undef. @@ -800,7 +800,7 @@ The non-default services (anything other than DB) are not well tested. =head1 SEE ALSO -Travel::Status::DE::HAFAS::Result(3pm), Travel::Status::DE::HAFAS::StopFinder(3pm). +Travel::Status::DE::HAFAS::Journey(3pm), Travel::Status::DE::HAFAS::StopFinder(3pm). =head1 AUTHOR diff --git a/lib/Travel/Status/DE/HAFAS/Journey.pm b/lib/Travel/Status/DE/HAFAS/Journey.pm new file mode 100644 index 0000000..31675ba --- /dev/null +++ b/lib/Travel/Status/DE/HAFAS/Journey.pm @@ -0,0 +1,432 @@ +package Travel::Status::DE::HAFAS::Journey; + +use strict; +use warnings; +use 5.014; + +no if $] >= 5.018, warnings => 'experimental::smartmatch'; + +use parent 'Class::Accessor'; + +our $VERSION = '3.01'; + +Travel::Status::DE::HAFAS::Journey->mk_ro_accessors( + qw(sched_date date sched_datetime datetime info is_cancelled operator delay + sched_time time train route route_end) +); + +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} // [] }; + my @remL = @{ $opt{common}{remL} // [] }; + my @himL = @{ $opt{common}{himL} // [] }; + + my $hafas = $opt{hafas}; + 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}; + my $train_type = $product->{prodCtx}{catOutS}; + my $line_no = $product->{prodCtx}{line}; + + my $operator; + if ( defined $product->{oprX} ) { + if ( my $opref = $opL[ $product->{oprX} ] ) { + $operator = $opref->{name}; + } + } + + my @messages; + for my $msg ( @{ $journey->{msgL} // [] } ) { + if ( $msg->{type} eq 'REM' and defined $msg->{remX} ) { + push( @messages, $hafas->add_message( $remL[ $msg->{remX} ] ) ); + } + elsif ( $msg->{type} eq 'HIM' and defined $msg->{himX} ) { + push( @messages, $hafas->add_message( $himL[ $msg->{himX} ], 1 ) ); + } + else { + say "Unknown message type $msg->{type}"; + } + } + + my @stops; + for my $stop ( @{ $journey->{stopL} // [] } ) { + my $loc = $locL[ $stop->{locX} ]; + my $arr = $stop->{aTimeS}; + my $arr_dt; + if ($arr) { + if ( length($arr) == 8 ) { + + # arrival time includes a day offset + my $offset_date = $hafas->{now}->clone; + $offset_date->add( days => substr( $arr, 0, 2, q{} ) ); + $offset_date = $offset_date->strftime('%Y%m%d'); + $arr_dt = $hafas->{strptime_obj} + ->parse_datetime("${offset_date}T${arr}"); + } + else { + $arr_dt + = $hafas->{strptime_obj}->parse_datetime("${date}T${arr}"); + } + } + push( + @stops, + { + name => $loc->{name}, + eva => $loc->{extId} + 0, + arrival => $arr_dt, + } + ); + } + + 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 ( $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'); + + return $ref; +} + +sub countdown { + my ($self) = @_; + + $self->{countdown} + //= $self->datetime->subtract_datetime( $self->{datetime_now} ) + ->in_units('minutes'); + + return $self->{countdown}; +} + +sub countdown_sec { + my ($self) = @_; + + $self->{countdown_sec} + //= $self->datetime->subtract_datetime( $self->{datetime_now} ) + ->in_units('seconds'); + + return $self->{countdown_sec}; +} + +sub destination { + my ($self) = @_; + + return $self->{route_end}; +} + +sub line { + my ($self) = @_; + + return $self->{train}; +} + +sub is_changed_platform { + my ($self) = @_; + + if ( defined $self->{new_platform} and defined $self->{platform} ) { + if ( $self->{new_platform} ne $self->{platform} ) { + return 1; + } + return 0; + } + if ( defined $self->{net_platform} ) { + return 1; + } + + return 0; +} + +sub messages { + my ($self) = @_; + + if ( $self->{messages} ) { + return @{ $self->{messages} }; + } + return; +} + +sub origin { + my ($self) = @_; + + return $self->{route_end}; +} + +sub platform { + my ($self) = @_; + + return $self->{new_platform} // $self->{platform}; +} + +sub TO_JSON { + my ($self) = @_; + + return { %{$self} }; +} + +sub type { + my ($self) = @_; + my $type; + + # $self->{train} is either "TYPE 12345" or "TYPE12345" + if ( $self->{train} =~ m{ \s }x ) { + ($type) = ( $self->{train} =~ m{ ^ ([^[:space:]]+) }x ); + } + else { + ($type) = ( $self->{train} =~ m{ ^ ([[:alpha:]]+) }x ); + } + + return $type; +} + +sub line_no { + my ($self) = @_; + my $line_no; + + # $self->{train} is either "TYPE 12345" or "TYPE12345" + if ( $self->{train} =~ m{ \s }x ) { + ($line_no) = ( $self->{train} =~ m{ ([^[:space:]]+) $ }x ); + } + else { + ($line_no) = ( $self->{train} =~ m{ ([[:digit:]]+) $ }x ); + } + + return $line_no; +} + +sub train_no { + my ($self) = @_; + + return $self->line_no; +} + +1; + +__END__ + +=head1 NAME + +Travel::Status::DE::HAFAS::Journey - Information about a single +arrival/departure received by Travel::Status::DE::HAFAS + +=head1 SYNOPSIS + + for my $departure ($status->results) { + printf( + "At %s: %s to %s from platform %s\n", + $departure->time, + $departure->line, + $departure->destination, + $departure->platform, + ); + } + + # or (depending on module setup) + for my $arrival ($status->results) { + printf( + "At %s: %s from %s on platform %s\n", + $arrival->time, + $arrival->line, + $arrival->origin, + $arrival->platform, + ); + } + +=head1 VERSION + +version 3.01 + +=head1 DESCRIPTION + +Travel::Status::DE::HAFAS::Journey describes a single arrival/departure +as obtained by Travel::Status::DE::HAFAS. It contains information about +the platform, time, route and more. + +=head1 METHODS + +=head2 ACCESSORS + +=over + +=item $result->countdown + +Difference between the time Travel::Status::DE::HAFAS->results +was called first and the arrival/departure time, in minutes. + +=item $result->countdown_sec + +Difference between the time Travel::Status::DE::HAFAS->results +was called first and the arrival/departure time, in seconds. + +=item $result->date + +Arrival/Departure date in "dd.mm.yyyy" format. + +=item $result->datetime + +DateTime object holding the arrival/departure date and time. + +=item $result->delay + +Returns the delay in minutes, or undef if it is unknown. +Also returns undef if the arrival/departure has been cancelled. + +=item $result->info + +Returns additional information, for instance the most recent delay reason. +undef if no (useful) information is available. + +=item $result->is_cancelled + +True if the arrival/departure was cancelled, false otherwise. + +=item $result->is_changed_platform + +True if the platform (as returned by the B accessor) is not the +scheduled one. Note that the scheduled platform is unknown in this case. + +=item $result->messages + +Returns a list of message strings related to this result. Messages usually are +service notices (e.g. "missing carriage") or detailed delay reasons +(e.g. "switch damage between X and Y, expect delays"). + +=item $result->line + +=item $result->train + +Returns the line name, either in a format like "Bus SB16" (Bus line SB16) +or "RE 10111" (RegionalExpress train 10111, no line information). +May contain extraneous whitespace characters. + +=item $result->line_no + +=item $result->train_no + +Returns the line/train number, for instance "SB16" (bus line SB16), +"11" (Underground train line U 11) or 1011 ("RegionalExpress train 1011"). +Note that this may not be a number at all: Some transport services also +use single-letter characters or words (e.g. "AIR") as line numbers. + +=item $result->operator + +Returns the operator responsible for this arrival/departure. Returns undef +if the backend does not provide an operator. + +Note that EBB is the only known backend providing this information. + +=item $result->platform + +Returns the arrival/departure platform. +Realtime data if available, schedule data otherwise. + +=item $result->route_end + +=item $result->destination + +=item $result->origin + +Returns the last element of the route. Depending on how you set up +Travel::Status::DE::HAFAS (arrival or departure listing), this is +either the result's destination or its origin station. + +=item $result->sched_date + +Scheduled arrival/departure date in "dd.mm.yyyy" format. + +=item $result->sched_datetime + +DateTime object holding the scheduled arrival/departure date and time. + +=item $result->sched_time + +Scheduled arrival/departure time in "hh:mm" format. + +=item $result->time + +Arrival/Departure time in "hh:mm" format. + +=item $result->type + +Returns the type of this result, e.g. "S" for S-Bahn, "RE" for Regional Express +or "STR" for tram / StraEenbahn. + +=back + +=head1 DIAGNOSTICS + +None. + +=head1 DEPENDENCIES + +=over + +=item Class::Accessor(3pm) + +=back + +=head1 BUGS AND LIMITATIONS + +None known. + +=head1 SEE ALSO + +Travel::Status::DE::HAFAS(3pm). + +=head1 AUTHOR + +Copyright (C) 2015-2020 by Daniel Friesel Ederf@finalrewind.orgE + +=head1 LICENSE + +This module is licensed under the same terms as Perl itself. diff --git a/lib/Travel/Status/DE/HAFAS/Result.pm b/lib/Travel/Status/DE/HAFAS/Result.pm deleted file mode 100644 index f1e376b..0000000 --- a/lib/Travel/Status/DE/HAFAS/Result.pm +++ /dev/null @@ -1,432 +0,0 @@ -package Travel::Status::DE::HAFAS::Result; - -use strict; -use warnings; -use 5.014; - -no if $] >= 5.018, warnings => 'experimental::smartmatch'; - -use parent 'Class::Accessor'; - -our $VERSION = '3.01'; - -Travel::Status::DE::HAFAS::Result->mk_ro_accessors( - qw(sched_date date sched_datetime datetime info is_cancelled operator delay - sched_time time train route route_end) -); - -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} // [] }; - my @remL = @{ $opt{common}{remL} // [] }; - my @himL = @{ $opt{common}{himL} // [] }; - - my $hafas = $opt{hafas}; - 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}; - my $train_type = $product->{prodCtx}{catOutS}; - my $line_no = $product->{prodCtx}{line}; - - my $operator; - if ( defined $product->{oprX} ) { - if ( my $opref = $opL[ $product->{oprX} ] ) { - $operator = $opref->{name}; - } - } - - my @messages; - for my $msg ( @{ $journey->{msgL} // [] } ) { - if ( $msg->{type} eq 'REM' and defined $msg->{remX} ) { - push( @messages, $hafas->add_message( $remL[ $msg->{remX} ] ) ); - } - elsif ( $msg->{type} eq 'HIM' and defined $msg->{himX} ) { - push( @messages, $hafas->add_message( $himL[ $msg->{himX} ], 1 ) ); - } - else { - say "Unknown message type $msg->{type}"; - } - } - - my @stops; - for my $stop ( @{ $journey->{stopL} // [] } ) { - my $loc = $locL[ $stop->{locX} ]; - my $arr = $stop->{aTimeS}; - my $arr_dt; - if ($arr) { - if ( length($arr) == 8 ) { - - # arrival time includes a day offset - my $offset_date = $hafas->{now}->clone; - $offset_date->add( days => substr( $arr, 0, 2, q{} ) ); - $offset_date = $offset_date->strftime('%Y%m%d'); - $arr_dt = $hafas->{strptime_obj} - ->parse_datetime("${offset_date}T${arr}"); - } - else { - $arr_dt - = $hafas->{strptime_obj}->parse_datetime("${date}T${arr}"); - } - } - push( - @stops, - { - name => $loc->{name}, - eva => $loc->{extId} + 0, - arrival => $arr_dt, - } - ); - } - - 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 ( $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'); - - return $ref; -} - -sub countdown { - my ($self) = @_; - - $self->{countdown} - //= $self->datetime->subtract_datetime( $self->{datetime_now} ) - ->in_units('minutes'); - - return $self->{countdown}; -} - -sub countdown_sec { - my ($self) = @_; - - $self->{countdown_sec} - //= $self->datetime->subtract_datetime( $self->{datetime_now} ) - ->in_units('seconds'); - - return $self->{countdown_sec}; -} - -sub destination { - my ($self) = @_; - - return $self->{route_end}; -} - -sub line { - my ($self) = @_; - - return $self->{train}; -} - -sub is_changed_platform { - my ($self) = @_; - - if ( defined $self->{new_platform} and defined $self->{platform} ) { - if ( $self->{new_platform} ne $self->{platform} ) { - return 1; - } - return 0; - } - if ( defined $self->{net_platform} ) { - return 1; - } - - return 0; -} - -sub messages { - my ($self) = @_; - - if ( $self->{messages} ) { - return @{ $self->{messages} }; - } - return; -} - -sub origin { - my ($self) = @_; - - return $self->{route_end}; -} - -sub platform { - my ($self) = @_; - - return $self->{new_platform} // $self->{platform}; -} - -sub TO_JSON { - my ($self) = @_; - - return { %{$self} }; -} - -sub type { - my ($self) = @_; - my $type; - - # $self->{train} is either "TYPE 12345" or "TYPE12345" - if ( $self->{train} =~ m{ \s }x ) { - ($type) = ( $self->{train} =~ m{ ^ ([^[:space:]]+) }x ); - } - else { - ($type) = ( $self->{train} =~ m{ ^ ([[:alpha:]]+) }x ); - } - - return $type; -} - -sub line_no { - my ($self) = @_; - my $line_no; - - # $self->{train} is either "TYPE 12345" or "TYPE12345" - if ( $self->{train} =~ m{ \s }x ) { - ($line_no) = ( $self->{train} =~ m{ ([^[:space:]]+) $ }x ); - } - else { - ($line_no) = ( $self->{train} =~ m{ ([[:digit:]]+) $ }x ); - } - - return $line_no; -} - -sub train_no { - my ($self) = @_; - - return $self->line_no; -} - -1; - -__END__ - -=head1 NAME - -Travel::Status::DE::HAFAS::Result - Information about a single -arrival/departure received by Travel::Status::DE::HAFAS - -=head1 SYNOPSIS - - for my $departure ($status->results) { - printf( - "At %s: %s to %s from platform %s\n", - $departure->time, - $departure->line, - $departure->destination, - $departure->platform, - ); - } - - # or (depending on module setup) - for my $arrival ($status->results) { - printf( - "At %s: %s from %s on platform %s\n", - $arrival->time, - $arrival->line, - $arrival->origin, - $arrival->platform, - ); - } - -=head1 VERSION - -version 3.01 - -=head1 DESCRIPTION - -Travel::Status::DE::HAFAS::Result describes a single arrival/departure -as obtained by Travel::Status::DE::HAFAS. It contains information about -the platform, time, route and more. - -=head1 METHODS - -=head2 ACCESSORS - -=over - -=item $result->countdown - -Difference between the time Travel::Status::DE::HAFAS->results -was called first and the arrival/departure time, in minutes. - -=item $result->countdown_sec - -Difference between the time Travel::Status::DE::HAFAS->results -was called first and the arrival/departure time, in seconds. - -=item $result->date - -Arrival/Departure date in "dd.mm.yyyy" format. - -=item $result->datetime - -DateTime object holding the arrival/departure date and time. - -=item $result->delay - -Returns the delay in minutes, or undef if it is unknown. -Also returns undef if the arrival/departure has been cancelled. - -=item $result->info - -Returns additional information, for instance the most recent delay reason. -undef if no (useful) information is available. - -=item $result->is_cancelled - -True if the arrival/departure was cancelled, false otherwise. - -=item $result->is_changed_platform - -True if the platform (as returned by the B accessor) is not the -scheduled one. Note that the scheduled platform is unknown in this case. - -=item $result->messages - -Returns a list of message strings related to this result. Messages usually are -service notices (e.g. "missing carriage") or detailed delay reasons -(e.g. "switch damage between X and Y, expect delays"). - -=item $result->line - -=item $result->train - -Returns the line name, either in a format like "Bus SB16" (Bus line SB16) -or "RE 10111" (RegionalExpress train 10111, no line information). -May contain extraneous whitespace characters. - -=item $result->line_no - -=item $result->train_no - -Returns the line/train number, for instance "SB16" (bus line SB16), -"11" (Underground train line U 11) or 1011 ("RegionalExpress train 1011"). -Note that this may not be a number at all: Some transport services also -use single-letter characters or words (e.g. "AIR") as line numbers. - -=item $result->operator - -Returns the operator responsible for this arrival/departure. Returns undef -if the backend does not provide an operator. - -Note that EBB is the only known backend providing this information. - -=item $result->platform - -Returns the arrival/departure platform. -Realtime data if available, schedule data otherwise. - -=item $result->route_end - -=item $result->destination - -=item $result->origin - -Returns the last element of the route. Depending on how you set up -Travel::Status::DE::HAFAS (arrival or departure listing), this is -either the result's destination or its origin station. - -=item $result->sched_date - -Scheduled arrival/departure date in "dd.mm.yyyy" format. - -=item $result->sched_datetime - -DateTime object holding the scheduled arrival/departure date and time. - -=item $result->sched_time - -Scheduled arrival/departure time in "hh:mm" format. - -=item $result->time - -Arrival/Departure time in "hh:mm" format. - -=item $result->type - -Returns the type of this result, e.g. "S" for S-Bahn, "RE" for Regional Express -or "STR" for tram / StraEenbahn. - -=back - -=head1 DIAGNOSTICS - -None. - -=head1 DEPENDENCIES - -=over - -=item Class::Accessor(3pm) - -=back - -=head1 BUGS AND LIMITATIONS - -None known. - -=head1 SEE ALSO - -Travel::Status::DE::HAFAS(3pm). - -=head1 AUTHOR - -Copyright (C) 2015-2020 by Daniel Friesel Ederf@finalrewind.orgE - -=head1 LICENSE - -This module is licensed under the same terms as Perl itself. -- cgit v1.2.3