diff options
Diffstat (limited to 'lib/Travel/Status/DE/HAFAS/Result.pm')
-rw-r--r-- | lib/Travel/Status/DE/HAFAS/Result.pm | 432 |
1 files changed, 0 insertions, 432 deletions
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<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. |