package Travel::Status::DE::DBRIS::Journey;

use strict;
use warnings;
use 5.020;

use parent 'Class::Accessor';

use Travel::Status::DE::DBRIS::Location;
use Travel::Status::DE::DBRIS::Operators;

our $VERSION = '0.26';

# ->number is deprecated
Travel::Status::DE::DBRIS::Journey->mk_ro_accessors(
	qw(admin_id day id trip trip_no line_no type number operator is_cancelled));

sub new {
	my ( $obj, %opt ) = @_;

	my $json     = $opt{json};
	my $strpdate = $opt{strpdate_obj};
	my $strptime = $opt{strptime_obj};

	my $ref = {
		id           => $opt{id},
		day          => $strpdate->parse_datetime( $json->{reisetag} ),
		trip         => $json->{zugName},
		is_cancelled => $json->{cancelled},
		raw_route    => $json->{halte},
		raw_polyline => $json->{polylineGroup}{polylineDescriptions},
		strptime_obj => $strptime,
	};

	if ( $json->{halte} and @{ $json->{halte} } ) {
		my %admin_id_ml;
		my %trip_no_ml;
		my %type_ml;

		for my $stop ( @{ $json->{halte} } ) {
			if ( defined $stop->{adminID} ) {
				$admin_id_ml{ $stop->{adminID} } += 1;
			}
			if ( defined $stop->{nummer} ) {
				$trip_no_ml{ $stop->{nummer} } += 1;
			}
			if ( defined $stop->{kategorie} ) {
				$type_ml{ $stop->{kategorie} } += 1;
			}
		}

		if (%admin_id_ml) {
			my @admin_id_argmax
			  = reverse sort { $admin_id_ml{$a} <=> $admin_id_ml{$b} }
			  keys %admin_id_ml;
			$ref->{admin_id} = $admin_id_argmax[0];
			if (
				my $op
				= Travel::Status::DE::DBRIS::Operators::get_operator_name(
					$ref->{admin_id}
				)
			  )
			{
				$ref->{operator} = $op;
			}

			# return most frequent admin ID first
			$ref->{admin_ids} = \@admin_id_argmax;
			$ref->{operators} = [
				map {
					Travel::Status::DE::DBRIS::Operators::get_operator_name($_)
					  // $_
				} @admin_id_argmax
			];
		}

		if (%type_ml) {
			my @type_argmax
			  = reverse sort { $type_ml{$a} <=> $type_ml{$b} } keys %type_ml;
			$ref->{type}  = $type_argmax[0];
			$ref->{types} = \@type_argmax;
		}

		if (%trip_no_ml) {
			my @trip_no_argmax
			  = reverse sort { $trip_no_ml{$a} <=> $trip_no_ml{$b} }
			  keys %trip_no_ml;
			$ref->{trip_no}      = $trip_no_argmax[0];
			$ref->{trip_numbers} = \@trip_no_argmax;
		}
	}

	# Number is either train no (ICE, RE) or line no (S, U, Bus, ...)
	# with no way of distinguishing between those
	if ( $ref->{trip} ) {
		my @trip_parts = split( qr{\s+}, $ref->{trip} );
		if ( not defined $ref->{type} ) {
			$ref->{type} = $trip_parts[0];
		}
		$ref->{number} = $trip_parts[-1];
		if ( not defined $ref->{trip_no} ) {
			$ref->{trip_no} = $ref->{number};
		}
	}

	# For some trips, the type also contains the trip number like "MEX19161"
	# If we can detect this, remove the number from the trip type
	if (    $ref->{trip_no}
		and $ref->{type}
		and $ref->{type} =~ m{ (?<actualtype> [^\d]+ ) $ref->{trip_no} $ }x )
	{
		$ref->{type} = $+{actualtype};
	}

	# The line number seems to be encoded in the trip ID
	if ( not defined $ref->{number}
		and $opt{id} =~ m{ [#] ZE [#] (?<line> [^#]+ ) [#] ZB [#] }x )
	{
		$ref->{number} = $+{line};
	}

	if (    defined $ref->{number}
		and defined $ref->{trip_no}
		and $ref->{number} ne $ref->{trip_no} )
	{
		$ref->{line_no} = $ref->{number};
	}

	bless( $ref, $obj );

	for my $message ( @{ $json->{himMeldungen} // [] } ) {
		push( @{ $ref->{messages} }, $message );
	}

	for my $message ( @{ $json->{priorisierteMeldungen} // [] } ) {
		push( @{ $ref->{messages} }, $message );
	}

	for my $attr ( @{ $json->{zugattribute} // [] } ) {
		push( @{ $ref->{attributes} }, $attr );
	}

	return $ref;
}

sub polyline {
	my ($self) = @_;

	if ( not $self->{raw_polyline} ) {
		return;
	}

	if ( $self->{polyline} ) {
		return @{ $self->{polyline} };
	}

	my $distance;
	my $polyline = [ map { { lon => $_->{lng}, lat => $_->{lat} } }
		  @{ $self->{raw_polyline}[0]{coordinates} } ];

	eval {
		require GIS::Distance;
		$distance = GIS::Distance->new;
	};

	if ($distance) {
		my %min_dist;
		for my $stop ( $self->route ) {
			for my $polyline_index ( 0 .. $#{$polyline} ) {
				my $pl = $polyline->[$polyline_index];
				my $dist
				  = $distance->distance_metal( $stop->{lat}, $stop->{lon},
					$pl->{lat}, $pl->{lon} );
				if ( not $min_dist{ $stop->{eva} }
					or $min_dist{ $stop->{eva} }{dist} > $dist )
				{
					$min_dist{ $stop->{eva} } = {
						dist  => $dist,
						index => $polyline_index,
					};
				}
			}
		}
		for my $stop ( $self->route ) {
			if ( $min_dist{ $stop->{eva} } ) {
				$polyline->[ $min_dist{ $stop->{eva} }{index} ]{stop}
				  = $stop;
			}
		}
	}

	$self->{polyline} = $polyline;

	return @{ $self->{polyline} };
}

sub route {
	my ($self) = @_;

	if ( $self->{route} ) {
		return @{ $self->{route} };
	}

	@{ $self->{route} }
	  = map {
		Travel::Status::DE::DBRIS::Location->new(
			json     => $_,
			operator =>
			  scalar Travel::Status::DE::DBRIS::Operators::get_operator_name(
				$_->{adminID}
			  ),
			strptime_obj => $self->{strptime_obj}
		)
	  } ( @{ $self->{raw_route} // [] },
		@{ $self->{raw_cancelled_route} // [] } );

	return @{ $self->{route} };
}

sub attributes {
	my ($self) = @_;

	return @{ $self->{attributes} // [] };
}

sub messages {
	my ($self) = @_;

	return @{ $self->{messages} // [] };
}

sub admin_ids {
	my ($self) = @_;

	return @{ $self->{admin_ids} // [] };
}

sub operators {
	my ($self) = @_;

	return @{ $self->{operators} // [] };
}

sub types {
	my ($self) = @_;

	return @{ $self->{types} // [] };
}

sub trip_numbers {
	my ($self) = @_;

	return @{ $self->{trip_numbers} // [] };
}

sub type_at {
	my ( $self, $loc, $ts ) = @_;
	for my $stop ( $self->route ) {
		if ( $stop->name eq $loc or $stop->eva eq $loc ) {
			if (   not defined $ts
				or not( $stop->sched_dep // $stop->sched_arr )
				or ( $stop->sched_dep // $stop->sched_arr )->epoch == $ts )
			{
				return $stop->type;
			}
		}
	}
	return;
}

sub trip_no_at {
	my ( $self, $loc, $ts ) = @_;
	for my $stop ( $self->route ) {
		if ( $stop->name eq $loc or $stop->eva eq $loc ) {
			if (   not defined $ts
				or not( $stop->sched_dep // $stop->sched_arr )
				or ( $stop->sched_dep // $stop->sched_arr )->epoch == $ts )
			{
				return $stop->trip_no;
			}
		}
	}
	return;
}

sub train {
	my ($self) = @_;

	warn('$journey->train accessor is deprecated; use ->trip instead');

	return $self->trip;
}

sub train_no {
	my ($self) = @_;

	warn('$journey->train_no accessor is deprecated; use ->trip_no instead');

	return $self->trip_no;
}

sub TO_JSON {
	my ($self) = @_;

	# transform raw_route into route (lazy accessor)
	$self->route;

	# transform raw_polyline into polyline (lazy accessor)
	$self->polyline;

	my $ret = { %{$self} };

	delete $ret->{strptime_obj};

	for my $k (qw(day)) {
		if ( $ret->{$k} ) {
			$ret->{$k} = $ret->{$k}->epoch;
		}
	}

	return $ret;
}

1;

__END__

=head1 NAME

Travel::Status::DE::DBRIS::Journey - Information about a single
journey received by Travel::Status::DE::DBRIS

=head1 SYNOPSIS

	my $status = Travel::Status::DE::DBRIS->new(journey => ...);
	my $journey = $status->result;

=head1 VERSION

version 0.26

=head1 DESCRIPTION

Travel::Status::DE::DBRIS::Journey describes a single journey that was obtained
by passing the B<journey> key to Travel::Status::DE::DBRIS->new or ->new_p.

=head1 METHODS

=head2 ACCESSORS

=over

=item $journey->day

DateTime(3pm) object encoding the day on which this journey departs at its
origin station.

=item $journey->id

Trip ID / journey ID, i.e., the argument passed to
Travel::Status::DE::DBRIS->new's B<journey> key.

=item $journey->admin_id

Admin ID identifying the operator of the journey.
In case there are mulitple operators, returns the one responsible for the
majority of stops.

=item $journey->admin_ids

List of strings indirectly identifying the operators of the journey, in
descending order of the number of stops they are responsible for.

=item $journey->operator

String naming the operator of the journey.  In case there are mulitple
operators, returns the one responsible for the majority of stops.

=item $journey->operators

List of strings naming the operators of the journey, in descending order of the
number of stops they are responsible for.

=item $journey->train

Textual description of the departure, typically consisting of type identifier
(e.g. C<< S >>, C<< U >>) and line or trip number.

=item $journey->train_no

Trip number, if available. undef otherwise.

=item $journey->trip_no_at($stop, $epoch)

Return trip number at I<$stop> (name or EVA ID), if available.  Optionally,
I<$epoch> can be used to only match stops where scheduled departure or arrival
is equal to I<$epoch>. This is useful in case a trip passes the same stop
multiple times.

=item $journey->line_no

Line identifier, if available. undef otherwise. Note that the line identifier
is not necessarily numeric.

=item $journey->type

Trip type, e.g. C<< S >> (S-Bahn) or C<< U >> (U-Bahn / subway).
undef if unknown.

=item $journey->is_cancelled

True if this trip has been cancelled, false/undef otherwise.

=item $journey->polyline

List of geocoordinates that describe the trip's route. Only available if the
DBRIS constructor was called with B<with_polyline> set to a true value.  Each
list entry is a hash with the following keys.

=over

=item * lon (longitude)

=item * lat (latitude)

=item * stop (Travel::Status::DE::DBRIS::Location(3pm) object describing the stop at this location, if any)

=back

The B<stop> keys are only available if the optional dependency
GIS::Distance(3pm) is available. Note that the B<lon> and B<lat> keys in a
referenced stop may differ from the B<lon> and B<lat> keys in a polyline entry.

=item $journey->route

List of Travel::Status::DE::DBRIS::Location(3pm) objects that describe
individual stops along the trip.

=item $journey->attributes

List of attributes associated with this trip.
Each list entry is a hashref with some or all of the following keys.

=over

=item * value (textual description of attribute)

=item * teilstreckenHinweis (text describing that this attribute only applies to part of the trip's route)

=back

=item $journey->messages

List of attributes associated with this trip.
Each list entry is a hashref with some or all of the following keys.

=over

=item * prioritaet (priority, e.g. HOCH or NIEDRIG)

=item * ueberschrift (headline)

=item * text (message text)

=back

=back

=head1 DIAGNOSTICS

None.

=head1 DEPENDENCIES

=over

=item Class::Accessor(3pm)

=item GIS::Distance(3pm)

Optional, required for B<stop> keys in B<polyline> entries.

=back

=head1 BUGS AND LIMITATIONS

None known.

=head1 SEE ALSO

Travel::Status::DE::DBRIS(3pm).

=head1 AUTHOR

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

=head1 LICENSE

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