path: root/bin/dbris-m

#!perl
use strict;
use warnings;
use 5.020;

our $VERSION = '0.01';

use utf8;
use DateTime;
use Encode qw(decode);
use JSON;
use Getopt::Long qw(:config no_ignore_case);
use List::Util   qw(max);
use Travel::Status::DE::DBRIS;

my $developer_mode;
my $show_jid;
my $use_cache = 1;
my $cache;
my ( $json_output, $raw_json_output );

my @output;

binmode( STDOUT, ':encoding(utf-8)' );
for my $arg (@ARGV) {
	$arg = decode( 'UTF-8', $arg );
}

my $output_bold  = -t STDOUT ? "\033[1m" : q{};
my $output_reset = -t STDOUT ? "\033[0m" : q{};

GetOptions(
	'h|help'     => sub { show_help(0) },
	'j|with-jid' => \$show_jid,
	'V|version'  => \&show_version,
	'cache!'     => \$use_cache,
	'devmode'    => \$developer_mode,
	'json'       => \$json_output,
	'raw-json'   => \$raw_json_output,

) or show_help(1);

if ($use_cache) {
	my $cache_path = ( $ENV{XDG_CACHE_HOME} // "$ENV{HOME}/.cache" )
	  . '/Travel-Status-DE-DBRIS';
	eval {
		require Cache::File;
		$cache = Cache::File->new(
			cache_root      => $cache_path,
			default_expires => '90 seconds',
			lock_level      => Cache::File::LOCK_LOCAL(),
		);
	};
	if ($@) {
		$cache = undef;
	}
}

my %opt = (
	cache          => $cache,
	station        => shift || show_help(1),
	developer_mode => $developer_mode,
);

if ( $opt{station} =~ m{ ^ (?<lat> [0-9.]+ ) : (?<lon> [0-9].+ ) $ }x ) {
	$opt{geoSearch} = {
		latitude  => $+{lat},
		longitude => $+{lon},
	};
	delete $opt{station};
}
elsif ( $opt{station} =~ m{ ^ [?] (?<query> .*) $ }x ) {
	$opt{locationSearch} = $+{query};
	delete $opt{station};
}
elsif ( $opt{station} =~ m{[|]} ) {
	$opt{journey} = $opt{station};
	delete $opt{station};
}
elsif ( $opt{station} !~ m{ ^ \d+ $ }x ) {
	my $status
	  = Travel::Status::DE::DBRIS->new( locationSearch => $opt{station} );
	for my $result ( $status->results ) {
		if ( defined $result->eva ) {
			$opt{station} = $result;
			last;
		}
	}
}

my $status = Travel::Status::DE::DBRIS->new(%opt);

sub show_help {
	my ($code) = @_;

	print "Usage: db-ris-m <station|lat:lon>\n" . "See also: man dbris-m\n";

	exit $code;
}

sub show_version {
	say "dbris-m version ${VERSION}";

	exit 0;
}

sub spacer {
	my ($len) = @_;
	return ( $len % 2 ? q { } : q{} ) . ( q{ ·} x ( $len / 2 ) );
}

sub display_occupancy {
	my ($occupancy) = @_;

	if ( not $occupancy ) {
		return q{ };
	}
	if ( $occupancy == 1 ) {
		return q{.};
	}
	if ( $occupancy == 2 ) {
		return q{o};
	}
	if ( $occupancy == 3 ) {
		return q{*};
	}
	if ( $occupancy == 4 ) {
		return q{!};
	}
	return q{?};
}

sub format_delay {
	my ( $delay, $len ) = @_;
	if ( $delay and $len ) {
		return sprintf( "(%+${len}d)", $delay );
	}
	return q{};
}

if ( my $err = $status->errstr ) {
	say STDERR "Request error: ${err}";
	exit 2;
}

if ($raw_json_output) {
	say JSON->new->convert_blessed->encode( $status->{raw_json} );
	exit 0;
}

if ($json_output) {
	if ( $opt{journey} ) {
		say JSON->new->convert_blessed->encode( $status->result );
	}
	else {
		say JSON->new->convert_blessed->encode( [ $status->results ] );
	}
	exit 0;
}

if ( $opt{station} ) {
	my $max_line = max map { length( $_->line ) } $status->results;
	my $max_dest
	  = max map { length( $_->destination // q{} ) } $status->results;
	my $max_delay = max map { length( $_->delay // q{} ) } $status->results;
	my $max_platform
	  = max map { length( $_->rt_platform // $_->platform // q{} ) }
	  $status->results;

	$max_delay += 1;

	for my $result ( $status->results ) {
		printf(
			"%s  %s  %${max_line}s  %${max_dest}s  %${max_platform}s\n",
			$result->is_cancelled ? '--:--' : $result->dep->strftime('%H:%M'),
			$result->delay
			? sprintf( "(%+${max_delay}d)", $result->delay )
			: q{ } x ( $max_delay + 2 ),
			$result->line,
			$result->destination // $result->via_last // q{???},
			$result->rt_platform // $result->platform // q{}
		);
		if ($show_jid) {
			say $result->id =~ s{ }{}gr;
		}
		for my $message ( $result->messages ) {
			say $message->{text};
		}
		if ( $show_jid or scalar $result->messages ) {
			say q{};
		}
	}
}
elsif ( $opt{journey} ) {
	my $trip = $status->result;

	my $max_name     = max map { length( $_->name ) } $trip->route;
	my $max_platform = max map { length( $_->platform // q{} ) } $trip->route;

	my $mark_stop = 0;
	my $now       = DateTime->now( time_zone => 'Europe/Berlin' );
	for my $i ( reverse 1 .. ( scalar $trip->route // 0 ) ) {
		my $stop = ( $trip->route )[ $i - 1 ];
		if (
			not $stop->is_cancelled
			and (  $stop->dep and $now <= $stop->dep
				or $stop->arr and $now <= $stop->arr )
		  )
		{
			$mark_stop = $stop;
		}
	}

	printf( "%s am %s\n\n", $trip->train, $trip->day->strftime('%d.%m.%Y') );

	for my $stop ( $trip->route ) {
		if ( $stop == $mark_stop ) {
			print($output_bold);
		}
		if ( $stop->is_cancelled ) {
			print('    --:--    ');
		}
		elsif ( $stop->arr and $stop->dep ) {
			printf( '%s → %s',
				$stop->arr->strftime('%H:%M'),
				$stop->dep->strftime('%H:%M'),
			);
		}
		elsif ( $stop->dep ) {
			printf( '        %s', $stop->dep->strftime('%H:%M') );
		}
		elsif ( $stop->arr ) {
			printf( '%s        ', $stop->arr->strftime('%H:%M') );
		}
		else {
			print('             ');
		}
		printf( "  %-${max_name}s  %${max_platform}s\n",
			$stop->name, $stop->platform // q{} );
		if ( $stop == $mark_stop ) {
			print($output_reset);
		}
	}
	if ( $trip->attributes ) {
		say q{};
	}
	for my $attr ( $trip->attributes ) {
		say $attr->{value};
	}
	if ( $trip->messages ) {
		say q{};
	}
	for my $message ( $trip->messages ) {
		say $message->{text};
	}
}
elsif ( $opt{geoSearch} ) {
	for my $result ( $status->results ) {
		if ( defined $result->eva ) {
			printf( "%8d  %s\n", $result->eva, $result->name );
		}
	}
}
elsif ( $opt{locationSearch} ) {
	for my $result ( $status->results ) {
		if ( defined $result->eva ) {
			printf( "%8d  %s\n", $result->eva, $result->name );
		}
	}
}

__END__

=head1 NAME

dbris-m - Interface to bahn.de / bahnhof.de RIS::*-based departure monitors

=head1 SYNOPSIS

B<dbris-m> I<station>

B<dbris-m> B<?>I<query>|I<lat>B<:>I<lon>

=head1 VERSION

version 0.01

=head1 DESCRIPTION

dbris-m is an interface to the public transport services operated by
Deutsche Bahn on bahn.de and bahnhof.de.

It can serve as an arrival/departure monitor, request details about a specific
trip/journey, and look up public transport stops by name or geolocation.
The operating mode depends on the contents of its non-option argument.

=head2 Departure Monitor (I<station>)

Show departures at I<station>. I<station> may be given as a station name or
station ID.  For each departure, B<dbris-m> shows

=over

=item * estimated departure time,

=item * delay, if known,

=item * trip name, number, or line,

=item * direction / destination, and

=item * platform, if known.

=back

=head2 Location Search (B<?>I<query>|I<lat>B<:>I<lon>)

List stations that match I<query> or that are located in the vicinity of
I<lat>B<:>I<lon> geocoordinates with station ID and name.

=head1 OPTIONS

Values in brackets indicate options that only apply to the corresponding
operating mode(s).

=over

=item B<--json>

Print result(s) as JSON and exit. This is a dump of internal data structures
and not guaranteed to remain stable between minor versions. Please use the
Travel::Status::DE::DBRIS(3pm) module if you need a proper API.

=item B<--no-cache>

If the Cache::File module is available, server replies are cached in
F<~/.cache/Travel-Status-DE-DBRIS> (or a path relative to C<$XDG_CACHE_HOME>,
if set) for 90 seconds. Use this option to disable caching. You can also use
B<--cache> to re-enable it.

=item B<--raw-json>

Print unprocessed API response as JSON and exit.
Useful for debugging and development purposes.

=item B<-V>, B<--version>

Show version information and exit.

=back

=head1 EXIT STATUS

0 upon success, 1 upon internal error, 2 upon backend error.

=head1 CONFIGURATION

None.

=head1 DEPENDENCIES

=over

=item * Class::Accessor(3pm)

=item * DateTime(3pm)

=item * LWP::UserAgent(3pm)

=back

=head1 BUGS AND LIMITATIONS

=over

=item * This module is very much work-in-progress

=item * At the moment, there is no way of getting journey IDs from the
departure monitor, and thus no way to get departure details.

=back

=head1 AUTHOR

Copyright (C) 2024 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt>

=head1 LICENSE

This program is licensed under the same terms as Perl itself.