diff options
Diffstat (limited to 'lib/Travel/Status/DE/HAFAS/Journey.pm')
| -rw-r--r-- | lib/Travel/Status/DE/HAFAS/Journey.pm | 432 |
1 files changed, 432 insertions, 0 deletions
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<platform> 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 E<Ouml>BB 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 / StraE<szlig>enbahn. + +=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 E<lt>derf@finalrewind.orgE<gt> + +=head1 LICENSE + +This module is licensed under the same terms as Perl itself. |