#!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;
use Travel::Routing::DE::DBRIS;

my ( $date, $time, $from, $to, $language );
my $mots;
my $discounts;
my $developer_mode;
my ( $json_output, $raw_json_output );
my $use_cache = 1;
my $show_full_route;
my $cache;

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(
	'd|date=s'             => \$date,
	'D|discounts=s'        => \$discounts,
	'h|help'               => sub { show_help(0) },
	'f|full-route'         => \$show_full_route,
	'm|modes-of-transit=s' => \$mots,
	'l|language=s'         => \$language,
	't|time=s'             => \$time,
	'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-Routing-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 ( $from_raw, $to_raw ) = @ARGV;

if ( not( $from_raw and $to_raw ) ) {
	show_help(1);
}

sub get_stop {
	my ($stop) = @_;
	my $ris = Travel::Status::DE::DBRIS->new(
		cache          => $cache,
		locationSearch => $stop,
		developer_mode => $developer_mode,
	);
	if ( my $err = $ris->errstr ) {
		say STDERR "Request error while looking up '${stop}': ${err}";
		exit 2;
	}
	my $found;
	for my $result ( $ris->results ) {
		if ( defined $result->eva ) {
			return $result;
		}
	}
	say "Could not find stop '${stop}'";
	exit 1;
}

my %opt = (
	from           => get_stop($from_raw),
	to             => get_stop($to_raw),
	language       => $language,
	cache          => $cache,
	developer_mode => $developer_mode,
);

if ( $date or $time ) {
	my $dt = DateTime->now( time_zone => 'Europe/Berlin' );
	if ($date) {
		if ( $date
			=~ m{ ^ (?<day> \d{1,2} ) [.] (?<month> \d{1,2} ) [.] (?<year> \d{4})? $ }x
		  )
		{
			$dt->set(
				day   => $+{day},
				month => $+{month}
			);
			if ( $+{year} ) {
				$dt->set( year => $+{year} );
			}
		}
		else {
			say '--date must be specified as DD.MM.[YYYY]';
			exit 1;
		}
	}
	if ($time) {
		if ( $time =~ m{ ^ (?<hour> \d{1,2} ) : (?<minute> \d{1,2} ) $ }x ) {
			$dt->set(
				hour   => $+{hour},
				minute => $+{minute},
				second => 0,
			);
		}
		else {
			say '--time must be specified as HH:MM';
			exit 1;
		}
	}
	$opt{datetime} = $dt;
}

if ($mots) {
	$opt{modes_of_transit} = [ split( qr{, *}, $mots ) ];
}

if ($discounts) {
	$opt{discounts} = [ split( qr{, *}, $discounts ) ];
}

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

	print "Usage: dbris [-d dd.mm.yyyy] [-t hh:mm] <from> <to>\n"
	  . "See also: man dbris-m\n";

	exit $code;
}

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

	exit 0;
}

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 or $occupancy == 99 ) {
		return q{!};
	}
	return q{?};
}

sub format_occupancy {
	my ($stop) = @_;

	return display_occupancy( $stop->occupancy_first )
	  . display_occupancy( $stop->occupancy_second );
}

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

my $ris = Travel::Routing::DE::DBRIS->new(%opt);

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

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

if ($json_output) {
	say JSON->new->convert_blessed->encode( [ $ris->connections ] );
	exit 0;
}

for my $connection ( $ris->connections ) {

	my $header = q{};
	for my $segment ( $connection->segments ) {
		if ( $segment->train_short ) {
			$header .= sprintf( '  %s', $segment->train_short );
		}
		elsif ( $segment->is_transfer ) {
			$header .= sprintf( '  %.1fkm', $segment->distance_m / 1e3 );
		}
		elsif ( $segment->is_walk ) {

			# not shown in header
		}
		else {
			$header .= q{  ??};
		}
	}

	say q{};
	printf(
		"%s  (%02d:%02d)  %s  %s%s%s\n\n",
		$connection->dep ? $connection->dep->strftime('%d.%m. %H:%M')
		: q{??.??. ??:??},
		$connection->duration->in_units( 'hours', 'minutes' ),
		$connection->arr ? $connection->arr->strftime('%H:%M') : q{??:??},
		format_occupancy($connection),
		defined $connection->price
		? sprintf( '  %s %s', $connection->price, $connection->price_unit )
		: q{},
		$header,
	);
	for my $segment ( $connection->segments ) {
		if ( $segment->is_transfer ) {
			for my $note ( $segment->transfer_notes ) {
				say $note;
			}
		}
		elsif ( $segment->is_walk ) {
			printf( "${output_bold}%s${output_reset} %dm  (≈ %d min.)\n",
				$segment->walk_name, $segment->distance_m,
				$segment->duration->in_units('minutes') );
			next;
		}
		elsif ( $segment->direction ) {
			printf( "${output_bold}%s${output_reset} → %s  %s\n",
				$segment->train_mid, $segment->direction,
				format_occupancy($segment) );
		}
		else {
			printf( "${output_bold}%s${output_reset}\n", $segment->train_long );
		}

		printf( "%s  ab  %s\n",
			$segment->dep->strftime('%H:%M'),
			$segment->dep_name );

		if ($show_full_route) {
			for my $stop ( $segment->route ) {
				printf( "%s  %s  %s\n",
					$stop->arr ? $stop->arr->strftime('%H:%M') : q{     },
					format_occupancy($stop), $stop->name, );
			}
		}

		printf( "%s  an  %s\n",
			$segment->arr->strftime('%H:%M'),
			$segment->arr_name );
		say q{};
	}
	say q{---------------------------------------};
}

__END__

=head1 NAME

dbris - Interface to bahn.de public transit routing service

=head1 SYNOPSIS

B<dbris> [B<-d> I<DD.MM.YYYY>] [B<-t> I<HH:MM>] I<from-stop> I<to-stop>

=head1 VERSION

version 0.01

=head1 DESCRIPTION

B<dbris-m> is an interface to the public transport services available on
bahn.de. According to word of mouth, it uses the HAFAS backend that can also
be accessed by Travel::Status::DE::HAFAS(3pm)'s DB service. However, the
bahn.de entry point is likely more reliable in the long run.

B<dbris-m> can serve as an arrival/departure monitor, request details about a
specific trip, 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 Trip details (I<JourneyID>)

List intermediate stops of I<JourneyID> (as given by the departure monitor when
invoed with B<-j> / B<--with-jid>) with arrival/departure time, delay (if
available), occupancy (if available), and stop name. Also includes some generic
trip information.

=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<-d>, B<--date> I<DD.MM.[YYYY]> (departure monitor)

Request departures on the specified date.
Default: today.

=item B<-j>, B<--with-jid> (departure monitor)

Show JourneyID for each listed arrival/departure.
These can be used to obtain details on individual trips with subsequent
B<dbris-m> invocations.

=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>

By default, if the Cache::File module is available, server replies are cached
for 90 seconds in F<~/.cache/Travel-Status-DE-DBRIS> (or a path relative to
C<$XDG_CACHE_HOME>, if set). Use this option to disable caching. You can 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<-t>, B<--date> I<HH:MM> (departure monitor)

Request departures on or after the specified time.
Default: now.

=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

=back

=head1 AUTHOR

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

=head1 LICENSE

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