summaryrefslogtreecommitdiff
path: root/lib/Travel/Status/DE/HAFAS/Stop.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Travel/Status/DE/HAFAS/Stop.pm')
-rw-r--r--lib/Travel/Status/DE/HAFAS/Stop.pm368
1 files changed, 368 insertions, 0 deletions
diff --git a/lib/Travel/Status/DE/HAFAS/Stop.pm b/lib/Travel/Status/DE/HAFAS/Stop.pm
new file mode 100644
index 0000000..98af9ed
--- /dev/null
+++ b/lib/Travel/Status/DE/HAFAS/Stop.pm
@@ -0,0 +1,368 @@
+package Travel::Status::DE::HAFAS::Stop;
+
+# vim:foldmethod=marker
+
+use strict;
+use warnings;
+use 5.014;
+
+use parent 'Class::Accessor';
+
+our $VERSION = '6.03';
+
+Travel::Status::DE::HAFAS::Stop->mk_ro_accessors(
+ qw(loc
+ rt_arr sched_arr arr arr_delay arr_cancelled prod_arr
+ rt_dep sched_dep dep dep_delay dep_cancelled prod_dep
+ delay direction
+ rt_platform sched_platform platform is_changed_platform
+ is_additional tz_offset
+ load
+ )
+);
+
+# {{{ Constructor
+
+sub new {
+ my ( $obj, %opt ) = @_;
+
+ my $stop = $opt{stop};
+ my $common = $opt{common};
+ my $prodL = $opt{prodL};
+ my $date = $opt{date};
+ my $datetime_ref = $opt{datetime_ref};
+ my $hafas = $opt{hafas};
+ my $strp_obj = $opt{hafas}{strptime_obj};
+
+ my $prod_arr
+ = defined $stop->{aProdX} ? $prodL->[ $stop->{aProdX} ] : undef;
+ my $prod_dep
+ = defined $stop->{dProdX} ? $prodL->[ $stop->{dProdX} ] : undef;
+
+ # dIn. / aOut. -> may passengers enter / exit the train?
+
+ my $sched_platform = $stop->{aPlatfS} // $stop->{dPlatfS};
+ my $rt_platform = $stop->{aPlatfR} // $stop->{dPlatfR};
+ my $changed_platform = $stop->{aPlatfCh} // $stop->{dPlatfCh};
+
+ my $arr_cancelled = $stop->{aCncl};
+ my $dep_cancelled = $stop->{dCncl};
+ my $is_additional = $stop->{isAdd};
+
+ my $ref = {
+ loc => $opt{loc},
+ direction => $stop->{dDirTxt},
+ sched_platform => $sched_platform,
+ rt_platform => $rt_platform,
+ is_changed_platform => $changed_platform,
+ platform => $rt_platform // $sched_platform,
+ arr_cancelled => $arr_cancelled,
+ dep_cancelled => $dep_cancelled,
+ is_additional => $is_additional,
+ prod_arr => $prod_arr,
+ prod_dep => $prod_dep,
+ };
+
+ bless( $ref, $obj );
+
+ my $sched_arr = $ref->handle_day_change(
+ input => $stop->{aTimeS},
+ offset => $stop->{aTZOffset},
+ date => $date,
+ strp_obj => $strp_obj,
+ ref => $datetime_ref
+ );
+
+ my $rt_arr = $ref->handle_day_change(
+ input => $stop->{aTimeR},
+ offset => $stop->{aTZOffset},
+ date => $date,
+ strp_obj => $strp_obj,
+ ref => $datetime_ref
+ );
+
+ my $sched_dep = $ref->handle_day_change(
+ input => $stop->{dTimeS},
+ offset => $stop->{dTZOffset},
+ date => $date,
+ strp_obj => $strp_obj,
+ ref => $datetime_ref
+ );
+
+ my $rt_dep = $ref->handle_day_change(
+ input => $stop->{dTimeR},
+ offset => $stop->{dTZOffset},
+ date => $date,
+ strp_obj => $strp_obj,
+ ref => $datetime_ref
+ );
+
+ $ref->{arr_delay}
+ = ( $sched_arr and $rt_arr )
+ ? ( $rt_arr->epoch - $sched_arr->epoch ) / 60
+ : undef;
+
+ $ref->{dep_delay}
+ = ( $sched_dep and $rt_dep )
+ ? ( $rt_dep->epoch - $sched_dep->epoch ) / 60
+ : undef;
+
+ $ref->{delay} = $ref->{dep_delay} // $ref->{arr_delay};
+
+ $ref->{sched_arr} = $sched_arr;
+ $ref->{sched_dep} = $sched_dep;
+ $ref->{rt_arr} = $rt_arr;
+ $ref->{rt_dep} = $rt_dep;
+ $ref->{arr} = $rt_arr // $sched_arr;
+ $ref->{dep} = $rt_dep // $sched_dep;
+
+ my @messages;
+ for my $msg ( @{ $stop->{msgL} // [] } ) {
+ if ( $msg->{type} eq 'REM' and defined $msg->{remX} ) {
+ push( @messages,
+ $hafas->add_message( $opt{common}{remL}[ $msg->{remX} ] ) );
+ }
+ elsif ( $msg->{type} eq 'HIM' and defined $msg->{himX} ) {
+ push( @messages,
+ $hafas->add_message( $opt{common}{himL}[ $msg->{himX} ], 1 ) );
+ }
+ else {
+ say "Unknown message type $msg->{type}";
+ }
+ }
+ $ref->{messages} = \@messages;
+
+ $ref->{load} = {};
+ for my $tco_id ( @{ $stop->{dTrnCmpSX}{tcocX} // [] } ) {
+ my $tco_kv = $common->{tcocL}[$tco_id];
+ $ref->{load}{ $tco_kv->{c} } = $tco_kv->{r};
+ }
+
+ return $ref;
+}
+
+# }}}
+
+sub handle_day_change {
+ my ( $self, %opt ) = @_;
+ my $date = $opt{date};
+ my $timestr = $opt{input};
+ my $offset = $opt{offset};
+
+ if ( not defined $timestr ) {
+ return;
+ }
+
+ if ( length($timestr) == 8 ) {
+
+ # arrival time includes a day offset
+ my $offset_date = $opt{ref}->clone;
+ $offset_date->add( days => substr( $timestr, 0, 2, q{} ) );
+ $offset_date = $offset_date->strftime('%Y%m%d');
+ $timestr = $opt{strp_obj}->parse_datetime("${offset_date}T${timestr}");
+ }
+ else {
+ $timestr = $opt{strp_obj}->parse_datetime("${date}T${timestr}");
+ }
+
+ if ( defined $offset and $offset != $timestr->offset / 60 ) {
+ $self->{tz_offset} = $offset - $timestr->offset / 60;
+ $timestr->subtract( minutes => $self->{tz_offset} );
+ }
+
+ return $timestr;
+}
+
+sub messages {
+ my ($self) = @_;
+
+ if ( $self->{messages} ) {
+ return @{ $self->{messages} };
+ }
+ return;
+}
+
+sub TO_JSON {
+ my ($self) = @_;
+
+ my $ret = { %{$self} };
+
+ for my $k ( keys %{$ret} ) {
+ if ( ref( $ret->{$k} ) eq 'DateTime' ) {
+ $ret->{$k} = $ret->{$k}->epoch;
+ }
+ }
+
+ return $ret;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Travel::Status::DE::HAFAS::Stop - Information about a HAFAS stop.
+
+=head1 SYNOPSIS
+
+ # in journey mode
+ for my $stop ($journey->route) {
+ printf(
+ %5s -> %5s %s\n",
+ $stop->arr ? $stop->arr->strftime('%H:%M') : '--:--',
+ $stop->dep ? $stop->dep->strftime('%H:%M') : '--:--',
+ $stop->loc->name
+ );
+ }
+
+=head1 VERSION
+
+version 6.03
+
+=head1 DESCRIPTION
+
+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.
+
+All date and time entries refer to the backend time zone (Europe/Berlin in most
+cases) and do not take local time into account; see B<tz_offset> for the
+latter.
+
+=head1 METHODS
+
+=head2 ACCESSORS
+
+=over
+
+=item $stop->loc
+
+Travel::Status::DE::HAFAS::Location(3pm) instance describing stop name, EVA
+ID, et cetera.
+
+=item $stop->rt_arr
+
+DateTime object for actual arrival.
+
+=item $stop->sched_arr
+
+DateTime object for scheduled arrival.
+
+=item $stop->arr
+
+DateTime object for actual or scheduled arrival.
+
+=item $stop->arr_delay
+
+Arrival delay in minutes.
+
+=item $stop->arr_cancelled
+
+Arrival is cancelled.
+
+=item $stop->rt_dep
+
+DateTime object for actual departure.
+
+=item $stop->sched_dep
+
+DateTime object for scheduled departure.
+
+=item $stop->dep
+
+DateTIme object for actual or scheduled departure.
+
+=item $stop->dep_delay
+
+Departure delay in minutes.
+
+=item $stop->dep_cancelled
+
+Departure is cancelled.
+
+=item $stop->tz_offset
+
+Offset between backend time zone (default: Europe/Berlin) and this stop's time
+zone in minutes, if any. For instance, if the backend uses UTC+2 (CEST) and the
+stop uses UTC+1 (IST), tz_offset is -60. Returns undef if both use the same
+time zone (or rather, the same UTC offset).
+
+=item $stop->delay
+
+Departure or arrival delay in minutes.
+
+=item $stop->direction
+
+Direction signage from this stop on, undef if unchanged.
+
+=item $stop->messages
+
+List of Travel::Status::DE::HAFAS::Message(3pm) instances related to this stop.
+These typically refer to delay reasons, platform changes, or changes in the
+line number / direction heading.
+
+=item $stop->prod_arr
+
+Travel::Status::DE::HAFAS::Product(3pm) instance describing the transit product
+(name, type, line number, operator, ...) upon arrival at this stop.
+
+=item $stop->prod_dep
+
+Travel::Status::DE::HAFAS::Product(3pm) instance describing the transit product
+(name, type, line number, operator, ...) upon departure from this stop.
+
+=item $stop->rt_platform
+
+Actual platform.
+
+=item $stop->sched_platform
+
+Scheduled platform.
+
+=item $stop->platform
+
+Actual or scheduled platform.
+
+=item $stop->is_changed_platform
+
+True if real-time and scheduled platform disagree.
+
+=item $stop->is_additional
+
+True if the stop is an unscheduled addition to the train's route.
+
+=item $stop->load
+
+Expected utilization / passenger load from this stop on.
+
+=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) 2023 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt>
+
+=head1 LICENSE
+
+This module is licensed under the same terms as Perl itself.
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-03 06:25:56 +0000