#!perl
use strict;
use warnings;
use 5.014;

our $VERSION = '0.01';

use utf8;
use DateTime;
use Encode qw(decode);
use JSON;
use Getopt::Long    qw(:config no_ignore_case);
use List::MoreUtils qw(uniq);
use List::Util      qw(first max);
use Travel::Routing::DE::HAFAS;
use Travel::Status::DE::HAFAS;

my ( $date, $time, $language );
my $types = q{};
my $developer_mode;
my $json_output;
my ( $list_services, $service );
my ( @excluded_mots, @exclusive_mots );
my $verbosity = 0;

my @output;
my %min_verbosity = (
	A => 3,
	C => 0,
	G => 2,
	H => 1,
	L => 0,
	M => 1,
	P => 0,
);

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,
	'h|help'       => sub { show_help(0) },
	'l|language=s' => \$language,
	'm|mot=s'      => \$types,
	's|service=s'  => \$service,
	't|time=s'     => \$time,
	'v|verbose+'   => \$verbosity,
	'V|version'    => \&show_version,
	'devmode'      => \$developer_mode,
	'json'         => \$json_output,
	'list'         => \$list_services,

) or show_help(1);

if ($list_services) {
	printf( "%-40s %-14s %s\n\n", 'operator', 'abbr. (-s)', 'languages (-l)' );
	for my $service ( Travel::Routing::DE::HAFAS::get_services() ) {
		printf(
			"%-40s %-14s %s\n",
			@{$service}{qw(name shortname)},
			join( q{ }, @{ $service->{languages} // [] } )
		);
	}
	exit 0;
}

parse_mot_options();

my ( $from_stop, $to_stop ) = @ARGV;

if ( not $from_stop and $to_stop ) {
	show_help(1);
}

my %opt = (
	excluded_mots  => \@excluded_mots,
	exclusive_mots => \@exclusive_mots,
	from_stop      => $from_stop,
	to_stop        => $to_stop,
	developer_mode => $developer_mode,
	service        => $service,
	language       => $language,
);

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;
}

my $hafas = Travel::Routing::DE::HAFAS->new(%opt);

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

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

	exit $code;
}

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

	exit 0;
}

sub parse_mot_options {

	my $default_yes = 1;

	for my $type ( split( qr{,}, $types ) ) {
		if ( $type eq 'help' or $type eq 'list' or $type eq q{?} ) {
			$service //= 'DB';
			my $desc = Travel::Routing::DE::HAFAS::get_service($service);
			if ($desc) {
				my @mots = @{ $desc->{productbits} };
				@mots = grep { $_ ne 'x' } @mots;
				@mots = uniq @mots;
				@mots = sort @mots;
				say join( "\n", @mots );
				exit 0;
			}
			else {
				say STDERR 'no modes of transport known for this service';
				exit 1;
			}
		}
		elsif ( substr( $type, 0, 1 ) eq q{!} ) {
			push( @excluded_mots, substr( $type, 1 ) );
		}
		else {
			push( @exclusive_mots, $type );
		}
	}
	return;
}

sub show_similar_stops {
	my $hafas_from = Travel::Status::DE::HAFAS->new(
		service        => $service,
		language       => $language,
		developer_mode => $developer_mode,
		locationSearch => $from_stop,
	);
	my $hafas_to = Travel::Status::DE::HAFAS->new(
		service        => $service,
		language       => $language,
		developer_mode => $developer_mode,
		locationSearch => $to_stop,
	);

	if (    $hafas_from->results
		and ( $hafas_from->results )[0]->eva ne $from_stop
		and ( $hafas_from->results )[0]->name ne $from_stop )
	{
		say q{};
		say 'You might want to try one of the following departure stops:';
		for my $result ( $hafas_from->results ) {
			printf( "%8d  %s\n", $result->eva, $result->name );
		}
	}

	if (    $hafas_to->results
		and ( $hafas_to->results )[0]->eva ne $to_stop
		and ( $hafas_to->results )[0]->name ne $to_stop )
	{
		say q{};
		say 'You might want to try one of the following arrival stops:';
		for my $result ( $hafas_to->results ) {
			printf( "%8d  %s\n", $result->eva, $result->name );
		}
	}
}

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

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

sub display_occupancies {
	my ($load) = @_;

	if ( $load and ( $load->{FIRST} or $load->{SECOND} ) ) {
		return sprintf( "[%1s%1s]",
			display_occupancy( $load->{FIRST} ),
			display_occupancy( $load->{SECOND} ) );
	}

	return q{    };
}

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

sub show_message {
	my ($msg) = @_;
	if ( $verbosity >= ( $min_verbosity{ $msg->type } // 0 ) ) {
		if ( $msg->short ) {
			printf( "| %s\n", $msg->short );
		}
		printf( "| %s\n", $msg->text );
		return 1;
	}
	return;
}

if ( my $err = $hafas->errstr ) {
	say STDERR "Request error: ${err}";
	if ( $hafas->errcode
		and ( $hafas->errcode eq 'H730' or $hafas->errcode eq 'LOCATION' ) )
	{
		show_similar_stops();
	}
	exit 2;
}

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

for my $res ( $hafas->connections ) {

	my $cancelled;
	for my $msg ( $res->messages ) {
		if ( $msg->type eq 'C' and $msg->text =~ m{Fahrt fällt aus} ) {
			$cancelled = 1;
		}
	}

	my $glance = q{};
	for my $sec ( $res->sections ) {
		if ( $sec->type ne 'JNY' ) {
			next;
		}
		if ( defined $sec->transfer_duration ) {
			$glance .= sprintf(
				'  (%01d:%02d)  %s',
				$sec->transfer_duration->in_units( 'hours', 'minutes' ),
				$sec->name
			);
		}
		else {
			$glance .= $sec->name;
		}
	}

	if ($cancelled) {
		printf( "--:--  %s  %s\n", display_occupancies( $res->load ), $glance );
	}
	else {
		printf(
			"%02d:%02d  %s  %s\n",
			$res->duration->in_units( 'hours', 'minutes' ),
			display_occupancies( $res->load ), $glance
		);
	}

	for my $msg ( $res->messages ) {
		show_message($msg);
	}
	say q{};

	my $have_delay = 0;

	for my $sec ( $res->sections ) {
		if ( $sec->dep_delay or $sec->arr_delay ) {
			$have_delay = 7;
		}
	}

	for my $sec ( $res->sections ) {
		if ( $sec->type eq 'JNY' ) {
			printf( "${output_bold}%s${output_reset} → %s\n",
				$sec->name, $sec->direction );
			printf(
				"%-5s %-${have_delay}s ab  %s%s%s\n",
				$sec->dep_cancelled
				? '--:--'
				: $sec->dep->strftime('%H:%M'),
				format_delay( $sec->dep_delay ),
				$sec->dep_loc->name,
				$sec->dep_platform ? q{: } : q{},
				$sec->dep_platform // q{},
			);
			printf(
				"%-5s %-${have_delay}s an  %s%s%s\n",
				$sec->arr_cancelled
				? '--:--'
				: $sec->arr->strftime('%H:%M'),
				format_delay( $sec->arr_delay ),
				$sec->arr_loc->name,
				$sec->arr_platform ? q{: } : q{},
				$sec->arr_platform // q{},
			);
		}
		elsif ( $sec->type eq 'WALK' ) {
			printf(
				"${output_bold}Walk %dm${output_reset}  (approx. %d minutes)\n",
				$sec->distance, $sec->duration->in_units('minutes') );
		}
		else {
			printf("\n???\n");
		}
		for my $msg ( $sec->messages ) {
			if ( $msg->code eq 'text.connection.section.arrival.date.deviation'
				or $msg->code eq
				'text.connection.section.departure.date.deviation' )
			{
				next;
			}
			show_message($msg);
		}
		say q{};
	}
	printf( "\n%s\n\n", q{-} x 40 );
}

__END__

=head1 NAME

hafas - Interface to HAFAS (e.g. Deutsche Bahn) itinerary services

=head1 SYNOPSIS

B<hafas> [B<-d> I<date>] [B<-t> I<time>] [B<-m> I<motlist>]
[B<-s> I<service>] [B<-l> I<language>] [B<-v>] I<from> I<to>

=head1 VERSION

version 0.01

=head1 DESCRIPTION

B<hafas> is a command line client for HAFAS-based public transit itinerary
services, e.g. the one operated by Deutsche Bahn. It requests connections
between two stops and prints the results.

=head1 OPTIONS

=over

=item B<-d>, B<--date> I<dd>.I<mm>.[I<yyyy>]

Planned departure (or arrival) date.  Default: today.

=item B<-l>, B<--language> I<language>

Request free-text messages to be provided in I<language>.
See B<--list> for a list of languages supported by individual HAFAS instances.
Note that requesting an invalid/unsupported language may lead to garbage output.

=item B<--list>

List known HAFAS installations and exit. Use B<-s>|B<--service> to select an
operator from this list for a HAFAS request.

=item B<-m>, B<--mot> I<motlist>

By default, B<hafas> considers all modes of transport for routing. With
I<motlist>, it is possible to either exclude a list of modes, or exclusively
show only a select list of modes.

To exclude modes, set I<motlist> to B<!>I<mot1>,B<!>I<mot2>,...

To show them exclusively, set I<motlist> to I<mot1>,I<mot2>,...

The I<mot> types depend on the used service. Use C<< -m help >> to list them.

=item B<-s>, B<--service> I<service>

Use the API provided by I<service> for routing; defaults to DB (Deutsche Bahn).
See B<--list> for a list of known services.

=item B<-t>, B<--time> I<hh>:I<mm>

Planned departure (or arrival) time.  Default: now.

=item B<-v>, B<--verbose>

Show more HAFAS messages, e.g. related to construction sites or Wi-Fi
availability. Repeating B<-v> increases the verbosity.  The level, and thus
number of different message types that B<hafas> displays, ranges from 0 (no
B<-v>) to 3 (B<-vvv>).

=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 * DateTime(3pm)

=item * Encode(3pm)

=item * JSON(3pm)

=item * List::MoreUtils(3pm)

=item * Travel::Routing::DE::HAFAS(3pm)

=item * Travel::Status::DE::HAFAS(3pm)

=back

=head1 BUGS AND LIMITATIONS

The non-default services (anything other than DB) are not well-tested.

=head1 AUTHOR

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

=head1 LICENSE

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