travelynx/lib/Travelynx.pm

package Travelynx;
use Mojo::Base 'Mojolicious';

use Mojo::Pg;
use Mojo::Promise;
use Mojolicious::Plugin::Authentication;
use Cache::File;
use Crypt::Eksblowfish::Bcrypt qw(bcrypt en_base64);
use DateTime;
use DateTime::Format::Strptime;
use Encode qw(decode encode);
use File::Slurp qw(read_file);
use JSON;
use List::Util;
use List::UtilsBy qw(uniq_by);
use List::MoreUtils qw(first_index);
use Travel::Status::DE::DBWagenreihung;
use Travel::Status::DE::IRIS::Stations;
use Travelynx::Helper::HAFAS;
use Travelynx::Helper::IRIS;
use Travelynx::Helper::Sendmail;
use Travelynx::Model::Journeys;
use Travelynx::Model::Users;
use XML::LibXML;

sub check_password {
	my ( $password, $hash ) = @_;

	if ( bcrypt( $password, $hash ) eq $hash ) {
		return 1;
	}
	return 0;
}

sub epoch_to_dt {
	my ($epoch) = @_;

	# Bugs (and user errors) may lead to undefined timestamps. Set them to
	# 1970-01-01 to avoid crashing and show obviously wrong data instead.
	$epoch //= 0;

	return DateTime->from_epoch(
		epoch     => $epoch,
		time_zone => 'Europe/Berlin',
		locale    => 'de-DE',
	);
}

sub get_station {
	my ( $station_name, $exact_match ) = @_;

	my @candidates
	  = Travel::Status::DE::IRIS::Stations::get_station($station_name);

	if ( @candidates == 1 ) {
		if ( not $exact_match ) {
			return $candidates[0];
		}
		if (   $candidates[0][0] eq $station_name
			or $candidates[0][1] eq $station_name
			or $candidates[0][2] eq $station_name )
		{
			return $candidates[0];
		}
		return undef;
	}
	return undef;
}

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

	push( @{ $self->commands->namespaces }, 'Travelynx::Command' );

	$self->defaults( layout => 'default' );

	$self->types->type( csv  => 'text/csv; charset=utf-8' );
	$self->types->type( json => 'application/json; charset=utf-8' );

	$self->plugin('Config');

	if ( $self->config->{secrets} ) {
		$self->secrets( $self->config->{secrets} );
	}

	chomp $self->app->config->{version};

	$self->plugin(
		authentication => {
			autoload_user => 1,
			fail_render   => { template => 'login' },
			load_user     => sub {
				my ( $self, $uid ) = @_;
				return $self->get_user_data($uid);
			},
			validate_user => sub {
				my ( $self, $username, $password, $extradata ) = @_;
				my $user_info
				  = $self->users->get_login_data( name => $username );
				if ( not $user_info ) {
					return undef;
				}
				if ( $user_info->{status} != 1 ) {
					return undef;
				}
				if ( check_password( $password, $user_info->{password_hash} ) )
				{
					return $user_info->{id};
				}
				return undef;
			},
		}
	);
	$self->sessions->default_expiration( 60 * 60 * 24 * 180 );

	# Starting with v8.11, Mojolicious sends SameSite=Lax Cookies by default.
	# In theory, "The default lax value provides a reasonable balance between
	# security and usability for websites that want to maintain user's logged-in
	# session after the user arrives from an external link". In practice,
	# Safari (both iOS and macOS) does not send a SameSite=lax cookie when
	# following a link from an external site. So, marudor.de providing a
	# checkin link to travelynx.de/s/whatever does not work because the user
	# is not logged in due to Safari not sending the cookie.
	#
	# This looks a lot like a Safari bug, but we can't do anything about it. So
	# we don't set the SameSite flag at all for now.
	#
	# --derf, 2019-05-01
	$self->sessions->samesite(undef);

	$self->defaults( layout => 'default' );

	$self->hook(
		before_dispatch => sub {
			my ($self) = @_;

           # The "theme" cookie is set client-side if the theme we delivered was
           # changed by dark mode detection or by using the theme switcher. It's
           # not part of Mojolicious' session data (and can't be, due to
           # signing and HTTPOnly), so we need to add it here.
			for my $cookie ( @{ $self->req->cookies } ) {
				if ( $cookie->name eq 'theme' ) {
					$self->session( theme => $cookie->value );
					return;
				}
			}
		}
	);

	$self->attr(
		cache_iris_main => sub {
			my ($self) = @_;

			return Cache::File->new(
				cache_root      => $self->app->config->{cache}->{schedule},
				default_expires => '6 hours',
				lock_level      => Cache::File::LOCK_LOCAL(),
			);
		}
	);

	$self->attr(
		cache_iris_rt => sub {
			my ($self) = @_;

			return Cache::File->new(
				cache_root      => $self->app->config->{cache}->{realtime},
				default_expires => '70 seconds',
				lock_level      => Cache::File::LOCK_LOCAL(),
			);
		}
	);

	$self->attr(
		token_type => sub {
			return {
				status  => 1,
				history => 2,
				travel  => 3,
				import  => 4,
			};
		}
	);
	$self->attr(
		token_types => sub {
			return [qw(status history travel import)];
		}
	);

	$self->attr(
		account_public_mask => sub {
			return {
				status_intern  => 0x01,
				status_extern  => 0x02,
				status_comment => 0x04,
				history_intern => 0x10,
				history_latest => 0x20,
				history_full   => 0x40,
			};
		}
	);

	$self->attr(
		journey_edit_mask => sub {
			return {
				sched_departure => 0x0001,
				real_departure  => 0x0002,
				from_station    => 0x0004,
				route           => 0x0010,
				is_cancelled    => 0x0020,
				sched_arrival   => 0x0100,
				real_arrival    => 0x0200,
				to_station      => 0x0400,
			};
		}
	);

	$self->attr(
		coordinates_by_station => sub {
			my $legacy_names = $self->app->renamed_station;
			my %location;
			for
			  my $station ( Travel::Status::DE::IRIS::Stations::get_stations() )
			{
				if ( $station->[3] ) {
					$location{ $station->[1] }
					  = [ $station->[4], $station->[3] ];
				}
			}
			while ( my ( $old_name, $new_name ) = each %{$legacy_names} ) {
				$location{$old_name} = $location{$new_name};
			}
			return \%location;
		}
	);

# https://de.wikipedia.org/wiki/Liste_nach_Gemeinden_und_Regionen_benannter_IC/ICE-Fahrzeuge#Namensgebung_ICE-Triebz%C3%BCge_nach_Gemeinden
# via https://github.com/marudor/BahnhofsAbfahrten/blob/master/src/server/Reihung/ICENaming.ts
	$self->attr(
		ice_name => sub {
			my $id_to_name = JSON->new->utf8->decode(
				scalar read_file('share/ice_names.json') );
			return $id_to_name;
		}
	);

	$self->attr(
		renamed_station => sub {
			my $legacy_to_new = JSON->new->utf8->decode(
				scalar read_file('share/old_station_names.json') );
			return $legacy_to_new;
		}
	);

	$self->attr(
		station_by_eva => sub {
			my %map;
			for
			  my $station ( Travel::Status::DE::IRIS::Stations::get_stations() )
			{
				$map{ $station->[2] } = $station;
			}
			return \%map;
		}
	);

	$self->helper(
		hafas => sub {
			my ($self) = @_;
			state $hafas = Travelynx::Helper::HAFAS->new(
				log            => $self->app->log,
				main_cache     => $self->app->cache_iris_main,
				realtime_cache => $self->app->cache_iris_rt,
				user_agent     => $self->ua,
				version        => $self->app->config->{version},
			);
		}
	);

	$self->helper(
		iris => sub {
			my ($self) = @_;
			state $hafas = Travelynx::Helper::IRIS->new(
				log            => $self->app->log,
				main_cache     => $self->app->cache_iris_main,
				realtime_cache => $self->app->cache_iris_rt,
				version        => $self->app->config->{version},
			);
		}
	);

	$self->helper(
		journeys => sub {
			my ($self) = @_;
			state $journeys = Travelynx::Model::Journeys->new(
				log             => $self->app->log,
				pg              => $self->pg,
				renamed_station => $self->app->renamed_station,
				station_by_eva  => $self->app->station_by_eva,
			);
		}
	);

	$self->helper(
		pg => sub {
			my ($self) = @_;
			my $config = $self->app->config;

			my $dbname = $config->{db}->{database};
			my $host   = $config->{db}->{host} // 'localhost';
			my $port   = $config->{db}->{port} // 5432;
			my $user   = $config->{db}->{user};
			my $pw     = $config->{db}->{password};

			state $pg
			  = Mojo::Pg->new("postgresql://${user}\@${host}:${port}/${dbname}")
			  ->password($pw);
		}
	);

	$self->helper(
		sendmail => sub {
			state $sendmail = Travelynx::Helper::Sendmail->new(
				config => ( $self->config->{mail} // {} ),
				log    => $self->log
			);
		}
	);

	$self->helper(
		users => sub {
			my ($self) = @_;
			state $users = Travelynx::Model::Users->new( pg => $self->pg );
		}
	);

	$self->helper(
		'now' => sub {
			return DateTime->now( time_zone => 'Europe/Berlin' );
		}
	);

	$self->helper(
		'numify_skipped_stations' => sub {
			my ( $self, $count ) = @_;

			if ( $count == 0 ) {
				return 'INTERNAL ERROR';
			}
			if ( $count == 1 ) {
				return
'Eine Station ohne Geokoordinaten wurde nicht berücksichtigt.';
			}
			return
"${count} Stationen ohne Geookordinaten wurden nicht berücksichtigt.";
		}
	);

	$self->helper(
		'grep_unknown_stations' => sub {
			my ( $self, @stations ) = @_;

			my @unknown_stations;
			for my $station (@stations) {
				my $station_info = get_station($station);
				if ( not $station_info ) {
					push( @unknown_stations, $station );
				}
			}
			return @unknown_stations;
		}
	);

	$self->helper(
		'checkin' => sub {
			my ( $self, $station, $train_id, $uid ) = @_;

			$uid //= $self->current_user->{id};

			my $status = $self->iris->get_departures(
				station    => $station,
				lookbehind => 140,
				lookahead  => 40
			);
			if ( $status->{errstr} ) {
				return ( undef, $status->{errstr} );
			}
			else {
				my ($train) = List::Util::first { $_->train_id eq $train_id }
				@{ $status->{results} };
				if ( not defined $train ) {
					return ( undef, "Train ${train_id} not found" );
				}
				else {

					my $user = $self->get_user_status($uid);
					if ( $user->{checked_in} or $user->{cancelled} ) {

						if (    $user->{train_id} eq $train_id
							and $user->{dep_eva} eq $status->{station_eva} )
						{
							# checking in twice is harmless
							return ( $train, undef );
						}

						# Otherwise, someone forgot to check out first
						$self->checkout( $station, 1, $uid );
					}

					eval {
						my $json = JSON->new;
						$self->pg->db->insert(
							'in_transit',
							{
								user_id   => $uid,
								cancelled => $train->departure_is_cancelled
								? 1
								: 0,
								checkin_station_id => $status->{station_eva},
								checkin_time =>
								  DateTime->now( time_zone => 'Europe/Berlin' ),
								dep_platform    => $train->platform,
								train_type      => $train->type,
								train_line      => $train->line_no,
								train_no        => $train->train_no,
								train_id        => $train->train_id,
								sched_departure => $train->sched_departure,
								real_departure  => $train->departure,
								route           => $json->encode(
									[ $self->route_diff($train) ]
								),
								messages => $json->encode(
									[
										map { [ $_->[0]->epoch, $_->[1] ] }
										  $train->messages
									]
								)
							}
						);
					};
					if ($@) {
						$self->app->log->error(
							"Checkin($uid): INSERT failed: $@");
						return ( undef, 'INSERT failed: ' . $@ );
					}
					$self->add_route_timestamps( $uid, $train, 1 );
					$self->run_hook( $uid, 'checkin' );
					return ( $train, undef );
				}
			}
		}
	);

	$self->helper(
		'undo' => sub {
			my ( $self, $journey_id, $uid ) = @_;
			$uid //= $self->current_user->{id};

			if ( $journey_id eq 'in_transit' ) {
				eval {
					$self->pg->db->delete( 'in_transit', { user_id => $uid } );
				};
				if ($@) {
					$self->app->log->error("Undo($uid, $journey_id): $@");
					return "Undo($journey_id): $@";
				}
				$self->run_hook( $uid, 'undo' );
				return undef;
			}
			if ( $journey_id !~ m{ ^ \d+ $ }x ) {
				return 'Invalid Journey ID';
			}

			eval {
				my $db = $self->pg->db;
				my $tx = $db->begin;

				my $journey = $db->select(
					'journeys',
					'*',
					{
						user_id => $uid,
						id      => $journey_id
					}
				)->hash;
				$db->delete(
					'journeys',
					{
						user_id => $uid,
						id      => $journey_id
					}
				);

				if ( $journey->{edited} ) {
					die(
"Cannot undo a journey which has already been edited. Please delete manually.\n"
					);
				}

				delete $journey->{edited};
				delete $journey->{id};

				$db->insert( 'in_transit', $journey );

				my $cache_ts = DateTime->now( time_zone => 'Europe/Berlin' );
				if ( $journey->{real_departure}
					=~ m{ ^ (?<year> \d{4} ) - (?<month> \d{2} ) }x )
				{
					$cache_ts->set(
						year  => $+{year},
						month => $+{month}
					);
				}

				$self->journeys->invalidate_stats_cache(
					ts  => $cache_ts,
					db  => $db,
					uid => $uid
				);

				$tx->commit;
			};
			if ($@) {
				$self->app->log->error("Undo($uid, $journey_id): $@");
				return "Undo($journey_id): $@";
			}
			$self->run_hook( $uid, 'undo' );
			return undef;
		}
	);

	$self->helper(
		'checkout' => sub {
			my ( $self, $station, $force, $uid ) = @_;

			my $db     = $self->pg->db;
			my $status = $self->iris->get_departures(
				station    => $station,
				lookbehind => 120,
				lookahead  => 120
			);
			$uid //= $self->current_user->{id};
			my $user     = $self->get_user_status($uid);
			my $train_id = $user->{train_id};

			if ( not $user->{checked_in} and not $user->{cancelled} ) {
				return ( 0, 'You are not checked into any train' );
			}
			if ( $status->{errstr} and not $force ) {
				return ( 1, $status->{errstr} );
			}

			my $now = DateTime->now( time_zone => 'Europe/Berlin' );
			my $journey
			  = $db->select( 'in_transit', '*', { user_id => $uid } )
			  ->expand->hash;

			# Note that a train may pass the same station several times.
			# Notable example: S41 / S42 ("Ringbahn") both starts and
			# terminates at Berlin Südkreuz
			my ($train) = List::Util::first {
				$_->train_id eq $train_id
				  and $_->sched_arrival
				  and $_->sched_arrival->epoch > $user->{sched_departure}->epoch
			}
			@{ $status->{results} };

			$train //= List::Util::first { $_->train_id eq $train_id }
			@{ $status->{results} };

			my $new_checkout_station_id = $status->{station_eva};

          # When a checkout is triggered by a checkin, there is an edge case
          # with related stations.
          # Assume a user travels from A to B1, then from B2 to C. B1 and B2 are
          # relatd stations (e.g. "Frankfurt Hbf" and "Frankfurt Hbf(tief)").
          # Now, if they check in for the journey from B2 to C, and have not yet
          # checked out of the previous train, $train is undef as B2 is not B1.
          # Redo the request with with_related => 1 to avoid this case.
          # While at it, we increase the lookahead to handle long journeys as
          # well.
			if ( not $train ) {
				$status = $self->iris->get_departures(
					station      => $station,
					lookbehind   => 120,
					lookahead    => 180,
					with_related => 1
				);
				($train) = List::Util::first { $_->train_id eq $train_id }
				@{ $status->{results} };
				if (    $train
					and $self->app->station_by_eva->{ $train->station_uic } )
				{
					$new_checkout_station_id = $train->station_uic;
				}
			}

			# Store the intended checkout station regardless of this operation's
			# success.
			$db->update(
				'in_transit',
				{
					checkout_station_id => $new_checkout_station_id,
				},
				{ user_id => $uid }
			);

			# If in_transit already contains arrival data for another estimated
			# destination, we must invalidate it.
			if ( defined $journey->{checkout_station_id}
				and $journey->{checkout_station_id}
				!= $new_checkout_station_id )
			{
				$db->update(
					'in_transit',
					{
						checkout_time => undef,
						arr_platform  => undef,
						sched_arrival => undef,
						real_arrival  => undef,
					},
					{ user_id => $uid }
				);
			}

			if ( not defined $train ) {

               # Arrival time via IRIS is unknown, so the train probably has not
               # arrived yet. Fall back to HAFAS.
               # TODO support cases where $station is EVA or DS100 code
				if (
					my $station_data
					= List::Util::first { $_->[0] eq $station }
					@{ $journey->{route} }
				  )
				{
					$station_data = $station_data->[1];
					if ( $station_data->{sched_arr} ) {
						my $sched_arr
						  = epoch_to_dt( $station_data->{sched_arr} );
						my $rt_arr = $sched_arr->clone;
						if (    $station_data->{adelay}
							and $station_data->{adelay} =~ m{^\d+$} )
						{
							$rt_arr->add( minutes => $station_data->{adelay} );
						}
						$db->update(
							'in_transit',
							{
								sched_arrival => $sched_arr,
								real_arrival  => $rt_arr
							},
							{ user_id => $uid }
						);
					}
				}
				if ( not $force ) {
					$self->run_hook( $uid, 'update' );
					return ( 1, undef );
				}
			}

			my $has_arrived = 0;

			eval {

				my $tx = $db->begin;

				if ( defined $train and not $train->arrival and not $force ) {
					my $train_no = $train->train_no;
					die("Train ${train_no} has no arrival timestamp\n");
				}
				elsif ( defined $train and $train->arrival ) {

					$has_arrived = $train->arrival->epoch < $now->epoch ? 1 : 0;
					my $json = JSON->new;
					$db->update(
						'in_transit',
						{
							checkout_time => $now,
							arr_platform  => $train->platform,
							sched_arrival => $train->sched_arrival,
							real_arrival  => $train->arrival,
							route =>
							  $json->encode( [ $self->route_diff($train) ] ),
							messages => $json->encode(
								[
									map { [ $_->[0]->epoch, $_->[1] ] }
									  $train->messages
								]
							)
						},
						{ user_id => $uid }
					);
					if ($has_arrived) {
						my @unknown_stations
						  = $self->grep_unknown_stations( $train->route );
						if (@unknown_stations) {
							$self->app->log->warn(
								'Encountered unknown stations: '
								  . join( ', ', @unknown_stations ) );
						}
					}
				}

				$journey
				  = $db->select( 'in_transit', '*', { user_id => $uid } )->hash;

				if ( $has_arrived or $force ) {
					delete $journey->{data};
					$journey->{edited}        = 0;
					$journey->{checkout_time} = $now;
					$db->insert( 'journeys', $journey );
					$db->delete( 'in_transit', { user_id => $uid } );

					my $cache_ts = $now->clone;
					if ( $journey->{real_departure}
						=~ m{ ^ (?<year> \d{4} ) - (?<month> \d{2} ) }x )
					{
						$cache_ts->set(
							year  => $+{year},
							month => $+{month}
						);
					}
					$self->journeys->invalidate_stats_cache(
						ts  => $cache_ts,
						db  => $db,
						uid => $uid
					);
				}
				elsif ( defined $train and $train->arrival_is_cancelled ) {

               # This branch is only taken if the deparure was not cancelled,
               # i.e., if the train was supposed to go here but got
               # redirected or cancelled on the way and not from the start on.
               # If the departure itself was cancelled, the user route is
               # cancelled_from action -> 'cancelled journey' panel on main page
               # -> cancelled_to action -> force checkout (causing the
               # previous branch to be taken due to $force)
					$journey->{edited}        = 0;
					$journey->{checkout_time} = $now;
					$journey->{cancelled}     = 1;
					delete $journey->{data};
					$db->insert( 'journeys', $journey );

					$journey
					  = $db->select( 'in_transit', ['data'],
						{ user_id => $uid } )->expand->hash;
					$journey->{data}{cancelled_destination} = $train->station;

					$db->update(
						'in_transit',
						{
							checkout_station_id => undef,
							checkout_time       => undef,
							arr_platform        => undef,
							sched_arrival       => undef,
							real_arrival        => undef,
							data => JSON->new->encode( $journey->{data} ),
						},
						{ user_id => $uid }
					);
				}

				$tx->commit;
			};

			if ($@) {
				$self->app->log->error("Checkout($uid): $@");
				return ( 1, 'Checkout error: ' . $@ );
			}

			if ( $has_arrived or $force ) {
				$self->run_hook( $uid, 'checkout' );
				return ( 0, undef );
			}
			$self->run_hook( $uid, 'update' );
			$self->add_route_timestamps( $uid, $train, 0 );
			return ( 1, undef );
		}
	);

	$self->helper(
		'update_in_transit_comment' => sub {
			my ( $self, $comment, $uid ) = @_;
			$uid //= $self->current_user->{id};

			my $status = $self->pg->db->select( 'in_transit', ['user_data'],
				{ user_id => $uid } )->expand->hash;
			if ( not $status ) {
				return;
			}
			$status->{user_data}{comment} = $comment;
			$self->pg->db->update(
				'in_transit',
				{ user_data => JSON->new->encode( $status->{user_data} ) },
				{ user_id   => $uid }
			);
		}
	);

	# This helper should only be called directly when also providing a user ID.
	# If you don't have one, use current_user() instead (get_user_data will
	# delegate to it anyways).
	$self->helper(
		'get_user_data' => sub {
			my ( $self, $uid ) = @_;

			$uid //= $self->current_user->{id};

			return $self->users->get_data( uid => $uid );
		}
	);

	$self->helper(
		'get_api_token' => sub {
			my ( $self, $uid ) = @_;
			$uid //= $self->current_user->{id};

			my $token = {};
			my $res   = $self->pg->db->select(
				'tokens',
				[ 'type', 'token' ],
				{ user_id => $uid }
			);

			for my $entry ( $res->hashes->each ) {
				$token->{ $self->app->token_types->[ $entry->{type} - 1 ] }
				  = $entry->{token};
			}

			return $token;
		}
	);

	$self->helper(
		'get_webhook' => sub {
			my ( $self, $uid ) = @_;
			$uid //= $self->current_user->{id};

			my $res_h
			  = $self->pg->db->select( 'webhooks_str', '*',
				{ user_id => $uid } )->hash;

			$res_h->{latest_run} = epoch_to_dt( $res_h->{latest_run_ts} );

			return $res_h;
		}
	);

	$self->helper(
		'set_webhook' => sub {
			my ( $self, %opt ) = @_;

			$opt{uid} //= $self->current_user->{id};

			if ( $opt{token} ) {
				$opt{token} =~ tr{\r\n}{}d;
			}

			my $res = $self->pg->db->insert(
				'webhooks',
				{
					user_id => $opt{uid},
					enabled => $opt{enabled},
					url     => $opt{url},
					token   => $opt{token}
				},
				{
					on_conflict => \
'(user_id) do update set enabled = EXCLUDED.enabled, url = EXCLUDED.url, token = EXCLUDED.token, errored = null, latest_run = null, output = null'
				}
			);
		}
	);

	$self->helper(
		'mark_hook_status' => sub {
			my ( $self, $uid, $url, $success, $text ) = @_;

			if ( length($text) > 1000 ) {
				$text = substr( $text, 0, 1000 ) . '…';
			}

			$self->pg->db->update(
				'webhooks',
				{
					errored    => $success ? 0 : 1,
					latest_run => DateTime->now( time_zone => 'Europe/Berlin' ),
					output     => $text,
				},
				{
					user_id => $uid,
					url     => $url
				}
			);
		}
	);

	$self->helper(
		'run_hook' => sub {
			my ( $self, $uid, $reason, $callback ) = @_;

			my $hook = $self->get_webhook($uid);

			if ( not $hook->{enabled} or not $hook->{url} =~ m{^ https?:// }x )
			{
				if ($callback) {
					&$callback();
				}
				return;
			}

			my $status    = $self->get_user_status_json_v1($uid);
			my $header    = {};
			my $hook_body = {
				reason => $reason,
				status => $status,
			};

			if ( $hook->{token} ) {
				$header->{Authorization} = "Bearer $hook->{token}";
				$header->{'User-Agent'}
				  = 'travelynx/' . $self->app->config->{version};
			}

			my $ua = $self->ua;
			if ($callback) {
				$ua->request_timeout(4);
			}
			else {
				$ua->request_timeout(10);
			}

			$ua->post_p( $hook->{url} => $header => json => $hook_body )->then(
				sub {
					my ($tx) = @_;
					if ( my $err = $tx->error ) {
						$self->mark_hook_status( $uid, $hook->{url}, 0,
							"HTTP $err->{code} $err->{message}" );
					}
					else {
						$self->mark_hook_status( $uid, $hook->{url}, 1,
							$tx->result->body );
					}
					if ($callback) {
						&$callback();
					}
				}
			)->catch(
				sub {
					my ($err) = @_;
					$self->mark_hook_status( $uid, $hook->{url}, 0, $err );
					if ($callback) {
						&$callback();
					}
				}
			)->wait;
		}
	);

	$self->helper(
		'get_journey_stats' => sub {
			my ( $self, %opt ) = @_;

			if ( $opt{cancelled} ) {
				$self->app->log->warn(
'get_journey_stats called with illegal option cancelled => 1'
				);
				return {};
			}

			my $uid   = $opt{uid}   // $self->current_user->{id};
			my $year  = $opt{year}  // 0;
			my $month = $opt{month} // 0;

			# Assumption: If the stats cache contains an entry it is up-to-date.
			# -> Cache entries must be explicitly invalidated whenever the user
			# checks out of a train or manually edits/adds a journey.

			my $res = $self->pg->db->select(
				'journey_stats',
				['data'],
				{
					user_id => $uid,
					year    => $year,
					month   => $month
				}
			);

			my $res_h = $res->expand->hash;

			if ($res_h) {
				$res->finish;
				return $res_h->{data};
			}

			my $interval_start = DateTime->new(
				time_zone => 'Europe/Berlin',
				year      => 2000,
				month     => 1,
				day       => 1,
				hour      => 0,
				minute    => 0,
				second    => 0,
			);

          # I wonder if people will still be traveling by train in the year 3000
			my $interval_end = $interval_start->clone->add( years => 1000 );

			if ( $opt{year} and $opt{month} ) {
				$interval_start->set(
					year  => $opt{year},
					month => $opt{month}
				);
				$interval_end = $interval_start->clone->add( months => 1 );
			}
			elsif ( $opt{year} ) {
				$interval_start->set( year => $opt{year} );
				$interval_end = $interval_start->clone->add( years => 1 );
			}

			my @journeys = $self->journeys->get(
				uid           => $uid,
				cancelled     => $opt{cancelled} ? 1 : 0,
				verbose       => 1,
				with_polyline => 1,
				after         => $interval_start,
				before        => $interval_end
			);
			my $stats = $self->compute_journey_stats(@journeys);

			eval {
				$self->pg->db->insert(
					'journey_stats',
					{
						user_id => $uid,
						year    => $year,
						month   => $month,
						data    => JSON->new->encode($stats),
					}
				);
			};
			if ( my $err = $@ ) {
				if ( $err =~ m{duplicate key value violates unique constraint} )
				{
                 # When a user opens the same history page several times in
                 # short succession, there is a race condition where several
                 # Mojolicious workers execute this helper, notice that there is
                 # no up-to-date history, compute it, and insert it using the
                 # statement above. This will lead to a uniqueness violation
                 # in each successive insert. However, this is harmless, and
                 # thus ignored.
				}
				else {
					# Otherwise we probably have a problem.
					die($@);
				}
			}

			return $stats;
		}
	);

	$self->helper(
		'history_years' => sub {
			my ( $self, $uid ) = @_;
			$uid //= $self->current_user->{id},

			  my $res = $self->pg->db->select(
				'journeys',
				'distinct extract(year from real_departure) as year',
				{ user_id  => $uid },
				{ order_by => { -asc => 'year' } }
			  );

			my @ret;
			for my $row ( $res->hashes->each ) {
				push( @ret, [ $row->{year}, $row->{year} ] );
			}
			return @ret;
		}
	);

	$self->helper(
		'history_months' => sub {
			my ( $self, $uid ) = @_;
			$uid //= $self->current_user->{id},

			  my $res = $self->pg->db->select(
				'journeys',
				"distinct to_char(real_departure, 'YYYY.MM') as yearmonth",
				{ user_id  => $uid },
				{ order_by => { -asc => 'yearmonth' } }
			  );

			my @ret;
			for my $row ( $res->hashes->each ) {
				my ( $year, $month ) = split( qr{[.]}, $row->{yearmonth} );
				push( @ret, [ "${year}/${month}", "${month}.${year}" ] );
			}
			return @ret;
		}
	);

	$self->helper(
		'route_diff' => sub {
			my ( $self, $train ) = @_;
			my @json_route;
			my @route       = $train->route;
			my @sched_route = $train->sched_route;

			my $route_idx = 0;
			my $sched_idx = 0;

			while ( $route_idx <= $#route and $sched_idx <= $#sched_route ) {
				if ( $route[$route_idx] eq $sched_route[$sched_idx] ) {
					push( @json_route, [ $route[$route_idx], {}, undef ] );
					$route_idx++;
					$sched_idx++;
				}

				# this branch is inefficient, but won't be taken frequently
				elsif ( not( grep { $_ eq $route[$route_idx] } @sched_route ) )
				{
					push( @json_route,
						[ $route[$route_idx], {}, 'additional' ],
					);
					$route_idx++;
				}
				else {
					push( @json_route,
						[ $sched_route[$sched_idx], {}, 'cancelled' ],
					);
					$sched_idx++;
				}
			}
			while ( $route_idx <= $#route ) {
				push( @json_route, [ $route[$route_idx], {}, 'additional' ], );
				$route_idx++;
			}
			while ( $sched_idx <= $#sched_route ) {
				push( @json_route,
					[ $sched_route[$sched_idx], {}, 'cancelled' ],
				);
				$sched_idx++;
			}
			return @json_route;
		}
	);

	$self->helper(
		'get_dbdb_station_p' => sub {
			my ( $self, $eva ) = @_;

			my $url = "https://lib.finalrewind.org/dbdb/s/${eva}.json";

			my $cache   = $self->app->cache_iris_main;
			my $promise = Mojo::Promise->new;

			if ( my $content = $cache->thaw($url) ) {
				$promise->resolve($content);
				return $promise;
			}

			$self->ua->request_timeout(5)->get_p($url)->then(
				sub {
					my ($tx) = @_;

					if ( my $err = $tx->error ) {
						return $promise->reject(
							"HTTP $err->{code} $err->{message}");
					}

					my $json = $tx->result->json;
					$cache->freeze( $url, $json );
					return $promise->resolve($json);
				}
			)->catch(
				sub {
					my ($err) = @_;
					return $promise->reject($err);
				}
			)->wait;
			return $promise;
		}
	);

	$self->helper(
		'has_wagonorder_p' => sub {
			my ( $self, $ts, $train_no ) = @_;
			my $api_ts = $ts->strftime('%Y%m%d%H%M');
			my $url
			  = "https://lib.finalrewind.org/dbdb/has_wagonorder/${train_no}/${api_ts}";
			my $cache   = $self->app->cache_iris_main;
			my $promise = Mojo::Promise->new;

			if ( my $content = $cache->get($url) ) {
				if ( $content eq 'y' ) {
					$promise->resolve;
					return $promise;
				}
				elsif ( $content eq 'n' ) {
					$promise->reject;
					return $promise;
				}
			}

			$self->ua->request_timeout(5)->head_p($url)->then(
				sub {
					my ($tx) = @_;
					if ( $tx->result->is_success ) {
						$cache->set( $url, 'y' );
						$promise->resolve;
					}
					else {
						$cache->set( $url, 'n' );
						$promise->reject;
					}
				}
			)->catch(
				sub {
					$cache->set( $url, 'n' );
					$promise->reject;
				}
			)->wait;
			return $promise;
		}
	);

	$self->helper(
		'get_wagonorder_p' => sub {
			my ( $self, $ts, $train_no ) = @_;
			my $api_ts = $ts->strftime('%Y%m%d%H%M');
			my $url
			  = "https://www.apps-bahn.de/wr/wagenreihung/1.0/${train_no}/${api_ts}";

			my $cache   = $self->app->cache_iris_main;
			my $promise = Mojo::Promise->new;

			if ( my $content = $cache->thaw($url) ) {
				$promise->resolve($content);
				return $promise;
			}

			$self->ua->request_timeout(5)->get_p($url)->then(
				sub {
					my ($tx) = @_;
					my $body = decode( 'utf-8', $tx->res->body );

					my $json = JSON->new->decode($body);
					$cache->freeze( $url, $json );
					$promise->resolve($json);
				}
			)->catch(
				sub {
					my ($err) = @_;
					$promise->reject($err);
				}
			)->wait;
			return $promise;
		}
	);

	$self->helper(
		'add_route_timestamps' => sub {
			my ( $self, $uid, $train, $is_departure ) = @_;

			$uid //= $self->current_user->{id};

			my $db = $self->pg->db;

			my $journey = $db->select(
				'in_transit_str',
				[ 'arr_eva', 'dep_eva', 'route', 'data' ],
				{ user_id => $uid }
			)->expand->hash;

			if ( not $journey ) {
				return;
			}

			if ( not $journey->{data}{trip_id} ) {
				my ( $origin_eva, $destination_eva, $polyline_str );
				$self->hafas->get_tripid_p($train)->then(
					sub {
						my ($trip_id) = @_;

						my $res = $db->select( 'in_transit', ['data'],
							{ user_id => $uid } );
						my $res_h = $res->expand->hash;
						my $data  = $res_h->{data} // {};

						$data->{trip_id} = $trip_id;

						$db->update(
							'in_transit',
							{ data    => JSON->new->encode($data) },
							{ user_id => $uid }
						);
						return $self->hafas->get_polyline_p( $train, $trip_id );
					}
				)->then(
					sub {
						my ($ret) = @_;
						my $polyline = $ret->{polyline};
						$origin_eva      = 0 + $ret->{raw}{origin}{id};
						$destination_eva = 0 + $ret->{raw}{destination}{id};

						# work around Cache::File turning floats into strings
						for my $coord ( @{$polyline} ) {
							@{$coord} = map { 0 + $_ } @{$coord};
						}

						$polyline_str = JSON->new->encode($polyline);

						return $db->select_p(
							'polylines',
							['id'],
							{
								origin_eva      => $origin_eva,
								destination_eva => $destination_eva,
								polyline        => $polyline_str
							},
							{ limit => 1 }
						);
					}
				)->then(
					sub {
						my ($pl_res) = @_;
						my $polyline_id;
						if ( my $h = $pl_res->hash ) {
							$polyline_id = $h->{id};
						}
						else {
							eval {
								$polyline_id = $db->insert(
									'polylines',
									{
										origin_eva      => $origin_eva,
										destination_eva => $destination_eva,
										polyline        => $polyline_str
									},
									{ returning => 'id' }
								)->hash->{id};
							};
							if ($@) {
								$self->app->log->warn(
									"add_route_timestamps: insert polyline: $@"
								);
							}
						}
						if ($polyline_id) {
							$db->update(
								'in_transit',
								{ polyline_id => $polyline_id },
								{ user_id     => $uid }
							);
						}
					}
				)->wait;
			}

			my ($platform) = ( ( $train->platform // 0 ) =~ m{(\d+)} );

			my $route = $journey->{route};

			my $base
			  = 'https://reiseauskunft.bahn.de/bin/trainsearch.exe/dn?L=vs_json.vs_hap&start=yes&rt=1';
			my $date_yy   = $train->start->strftime('%d.%m.%y');
			my $date_yyyy = $train->start->strftime('%d.%m.%Y');
			my $train_no  = $train->type . ' ' . $train->train_no;

			my ( $trainlink, $route_data );

			$self->hafas->get_json_p(
				"${base}&date=${date_yy}&trainname=${train_no}")->then(
				sub {
					my ($trainsearch) = @_;

					# Fallback: Take first result
					$trainlink = $trainsearch->{suggestions}[0]{trainLink};

					# Try finding a result for the current date
					for
					  my $suggestion ( @{ $trainsearch->{suggestions} // [] } )
					{

       # Drunken API, sail with care. Both date formats are used interchangeably
						if (
							$suggestion->{depDate}
							and (  $suggestion->{depDate} eq $date_yy
								or $suggestion->{depDate} eq $date_yyyy )
						  )
						{
            # Train numbers are not unique, e.g. IC 149 refers both to the
            # InterCity service Amsterdam -> Berlin and to the InterCity service
            # Koebenhavns Lufthavn st -> Aarhus.  One workaround is making
            # requests with the stationFilter=80 parameter.  Checking the origin
            # station seems to be the more generic solution, so we do that
            # instead.
							if ( $suggestion->{dep} eq $train->origin ) {
								$trainlink = $suggestion->{trainLink};
								last;
							}
						}
					}

					if ( not $trainlink ) {
						$self->app->log->debug("trainlink not found");
						return Mojo::Promise->reject("trainlink not found");
					}
					my $base2
					  = 'https://reiseauskunft.bahn.de/bin/traininfo.exe/dn';
					return $self->hafas->get_json_p(
"${base2}/${trainlink}?rt=1&date=${date_yy}&L=vs_json.vs_hap"
					);
				}
			)->then(
				sub {
					my ($traininfo) = @_;
					if ( not $traininfo or $traininfo->{error} ) {
						$self->app->log->debug("traininfo error");
						return Mojo::Promise->reject("traininfo error");
					}
					my $routeinfo
					  = $traininfo->{suggestions}[0]{locations};

					my $strp = DateTime::Format::Strptime->new(
						pattern   => '%d.%m.%y %H:%M',
						time_zone => 'Europe/Berlin',
					);

					$route_data = {};

					for my $station ( @{$routeinfo} ) {
						my $arr
						  = $strp->parse_datetime(
							$station->{arrDate} . ' ' . $station->{arrTime} );
						my $dep
						  = $strp->parse_datetime(
							$station->{depDate} . ' ' . $station->{depTime} );
						$route_data->{ $station->{name} } = {
							sched_arr => $arr ? $arr->epoch : 0,
							sched_dep => $dep ? $dep->epoch : 0,
						};
					}

					my $base2
					  = 'https://reiseauskunft.bahn.de/bin/traininfo.exe/dn';
					return $self->hafas->get_xml_p(
						"${base2}/${trainlink}?rt=1&date=${date_yy}&L=vs_java3"
					);
				}
			)->then(
				sub {
					my ($traininfo2) = @_;

					for my $station ( keys %{$route_data} ) {
						for my $key (
							keys %{ $traininfo2->{station}{$station} // {} } )
						{
							$route_data->{$station}{$key}
							  = $traininfo2->{station}{$station}{$key};
						}
					}

					for my $station ( @{$route} ) {
						$station->[1]
						  = $route_data->{ $station->[0] };
					}

					my $res = $db->select( 'in_transit', ['data'],
						{ user_id => $uid } );
					my $res_h = $res->expand->hash;
					my $data  = $res_h->{data} // {};

					$data->{delay_msg} = [ map { [ $_->[0]->epoch, $_->[1] ] }
						  $train->delay_messages ];
					$data->{qos_msg} = [ map { [ $_->[0]->epoch, $_->[1] ] }
						  $train->qos_messages ];

					$data->{him_msg} = $traininfo2->{messages};

					$db->update(
						'in_transit',
						{
							route => JSON->new->encode($route),
							data  => JSON->new->encode($data)
						},
						{ user_id => $uid }
					);
				}
			)->wait;

			if ( $train->sched_departure ) {
				$self->has_wagonorder_p( $train->sched_departure,
					$train->train_no )->then(
					sub {
						return $self->get_wagonorder_p( $train->sched_departure,
							$train->train_no );
					}
				)->then(
					sub {
						my ($wagonorder) = @_;

						my $res = $db->select(
							'in_transit',
							[ 'data', 'user_data' ],
							{ user_id => $uid }
						);
						my $res_h     = $res->expand->hash;
						my $data      = $res_h->{data} // {};
						my $user_data = $res_h->{user_data} // {};

						if ( $is_departure and not exists $wagonorder->{error} )
						{
							$data->{wagonorder_dep} = $wagonorder;
							if ( exists $user_data->{wagongroups} ) {
								$user_data->{wagongroups} = [];
							}
							for my $group (
								@{
									$wagonorder->{data}{istformation}
									  {allFahrzeuggruppe} // []
								}
							  )
							{
								my @wagons;
								for
								  my $wagon ( @{ $group->{allFahrzeug} // [] } )
								{
									push(
										@wagons,
										{
											id => $wagon->{fahrzeugnummer},
											number =>
											  $wagon->{wagenordnungsnummer},
											type => $wagon->{fahrzeugtyp},
										}
									);
								}
								push(
									@{ $user_data->{wagongroups} },
									{
										name =>
										  $group->{fahrzeuggruppebezeichnung},
										from =>
										  $group->{startbetriebsstellename},
										to => $group->{zielbetriebsstellename},
										no => $group->{verkehrlichezugnummer},
										wagons => [@wagons],
									}
								);
							}
							$db->update(
								'in_transit',
								{
									data      => JSON->new->encode($data),
									user_data => JSON->new->encode($user_data)
								},
								{ user_id => $uid }
							);
						}
						elsif ( not $is_departure
							and not exists $wagonorder->{error} )
						{
							$data->{wagonorder_arr} = $wagonorder;
							$db->update(
								'in_transit',
								{ data    => JSON->new->encode($data) },
								{ user_id => $uid }
							);
						}
					}
				)->wait;
			}

			if ($is_departure) {
				$self->get_dbdb_station_p( $journey->{dep_eva} )->then(
					sub {
						my ($station_info) = @_;

						my $res = $db->select( 'in_transit', ['data'],
							{ user_id => $uid } );
						my $res_h = $res->expand->hash;
						my $data  = $res_h->{data} // {};

						$data->{stationinfo_dep} = $station_info;

						$db->update(
							'in_transit',
							{ data    => JSON->new->encode($data) },
							{ user_id => $uid }
						);
					}
				)->wait;
			}

			if ( $journey->{arr_eva} and not $is_departure ) {
				$self->get_dbdb_station_p( $journey->{arr_eva} )->then(
					sub {
						my ($station_info) = @_;

						my $res = $db->select( 'in_transit', ['data'],
							{ user_id => $uid } );
						my $res_h = $res->expand->hash;
						my $data  = $res_h->{data} // {};

						$data->{stationinfo_arr} = $station_info;

						$db->update(
							'in_transit',
							{ data    => JSON->new->encode($data) },
							{ user_id => $uid }
						);
					}
				)->wait;
			}
		}
	);

	$self->helper(
		'get_latest_dest_id' => sub {
			my ( $self, %opt ) = @_;

			my $uid = $opt{uid} // $self->current_user->{id};
			my $db  = $opt{db}  // $self->pg->db;

			my $journey = $db->select( 'in_transit', ['checkout_station_id'],
				{ user_id => $uid } )->hash;
			if ( not $journey ) {
				$journey = $db->select(
					'journeys',
					['checkout_station_id'],
					{
						user_id   => $uid,
						cancelled => 0
					},
					{
						limit    => 1,
						order_by => { -desc => 'real_departure' }
					}
				)->hash;
			}

			if ( not $journey ) {
				return;
			}

			return $journey->{checkout_station_id};
		}
	);

	$self->helper(
		'get_connection_targets' => sub {
			my ( $self, %opt ) = @_;

			my $uid = $opt{uid} //= $self->current_user->{id};
			my $threshold = $opt{threshold}
			  // DateTime->now( time_zone => 'Europe/Berlin' )
			  ->subtract( months => 4 );
			my $db        = $opt{db} //= $self->pg->db;
			my $min_count = $opt{min_count} // 3;

			if ( $opt{destination_name} ) {
				return ( $opt{destination_name} );
			}

			my $dest_id = $opt{eva} // $self->get_latest_dest_id(%opt);

			if ( not $dest_id ) {
				return;
			}

			my $res = $db->query(
				qq{
					select
					count(checkout_station_id) as count,
					checkout_station_id as dest
					from journeys
					where user_id = ?
					and checkin_station_id = ?
					and real_departure > ?
					group by checkout_station_id
					order by count desc;
				},
				$uid,
				$dest_id,
				$threshold
			);
			my @destinations
			  = $res->hashes->grep( sub { shift->{count} >= $min_count } )
			  ->map( sub { shift->{dest} } )->each;
			@destinations
			  = grep { $self->app->station_by_eva->{$_} } @destinations;
			@destinations
			  = map { $self->app->station_by_eva->{$_}->[1] } @destinations;
			return @destinations;
		}
	);

	$self->helper(
		'get_connecting_trains' => sub {
			my ( $self, %opt ) = @_;

			my $uid         = $opt{uid} //= $self->current_user->{id};
			my $use_history = $self->users->use_history( uid => $uid );

			my ( $eva, $exclude_via, $exclude_train_id, $exclude_before );
			my $now = $self->now->epoch;

			if ( $opt{eva} ) {
				if ( $use_history & 0x01 ) {
					$eva = $opt{eva};
				}
				elsif ( $opt{destination_name} ) {
					$eva = $opt{eva};
				}
			}
			else {
				if ( $use_history & 0x02 ) {
					my $status = $self->get_user_status;
					$eva              = $status->{arr_eva};
					$exclude_via      = $status->{dep_name};
					$exclude_train_id = $status->{train_id};
					if ( $status->{real_arrival} ) {
						$exclude_before = $status->{real_arrival}->epoch;
					}
				}
			}

			$exclude_before //= $now - 300;

			if ( not $eva ) {
				return;
			}

			my @destinations = $self->get_connection_targets(%opt);

			if ($exclude_via) {
				@destinations = grep { $_ ne $exclude_via } @destinations;
			}

			if ( not @destinations ) {
				return;
			}

			my $stationboard = $self->iris->get_departures(
				station      => $eva,
				lookbehind   => 10,
				lookahead    => 40,
				with_related => 1
			);
			if ( $stationboard->{errstr} ) {
				return;
			}
			@{ $stationboard->{results} } = map { $_->[0] }
			  sort { $a->[1] <=> $b->[1] }
			  map  { [ $_, $_->departure ? $_->departure->epoch : 0 ] }
			  @{ $stationboard->{results} };
			my @results;
			my @cancellations;
			my %via_count = map { $_ => 0 } @destinations;
			for my $train ( @{ $stationboard->{results} } ) {
				if ( not $train->departure ) {
					next;
				}
				if (    $exclude_before
					and $train->departure
					and $train->departure->epoch < $exclude_before )
				{
					next;
				}
				if (    $exclude_train_id
					and $train->train_id eq $exclude_train_id )
				{
					next;
				}

             # In general, this function is meant to return feasible
             # connections. However, cancelled connections may also be of
             # interest and are also useful for logging cancellations.
             # To satisfy both demands with (hopefully) little confusion and
             # UI clutter, this function returns two concatenated arrays:
             # actual connections (ordered by actual departure time) followed
             # by cancelled connections (ordered by scheduled departure time).
             # This is easiest to achieve in two separate loops.
             #
             # Note that a cancelled train may still have a matching destination
             # in its route_post, e.g. if it leaves out $eva due to
             # unscheduled route changes but continues on schedule afterwards
             # -- so it is only cancelled at $eva, not on the remainder of
             # the route. Also note that this specific case is not yet handled
             # properly by the cancellation logic etc.

				if ( $train->departure_is_cancelled ) {
					my @via
					  = ( $train->sched_route_post, $train->sched_route_end );
					for my $dest (@destinations) {
						if ( List::Util::any { $_ eq $dest } @via ) {
							push( @cancellations, [ $train, $dest ] );
							next;
						}
					}
				}
				else {
					my @via = ( $train->route_post, $train->route_end );
					for my $dest (@destinations) {
						if ( $via_count{$dest} < 2
							and List::Util::any { $_ eq $dest } @via )
						{
							push( @results, [ $train, $dest ] );

                 # Show all past and up to two future departures per destination
							if ( not $train->departure
								or $train->departure->epoch >= $now )
							{
								$via_count{$dest}++;
							}
							next;
						}
					}
				}
			}

			@results = map { $_->[0] }
			  sort { $a->[1] <=> $b->[1] }
			  map {
				[
					$_,
					$_->[0]->departure->epoch // $_->[0]->sched_departure->epoch
				]
			  } @results;
			@cancellations = map { $_->[0] }
			  sort { $a->[1] <=> $b->[1] }
			  map { [ $_, $_->[0]->sched_departure->epoch ] } @cancellations;

			for my $result (@results) {
				my $train = $result->[0];
				my @message_ids
				  = List::Util::uniq map { $_->[1] } $train->raw_messages;
				$train->{message_id} = { map { $_ => 1 } @message_ids };
			}

			return ( @results, @cancellations );
		}
	);

	$self->helper(
		'stationinfo_to_direction' => sub {
			my ( $self, $platform_info, $wagonorder, $prev_stop, $next_stop )
			  = @_;
			if ( $platform_info->{kopfgleis} ) {
				if ($next_stop) {
					return $platform_info->{direction} eq 'r' ? 'l' : 'r';
				}
				return $platform_info->{direction};
			}
			elsif ( $prev_stop
				and exists $platform_info->{direction_from}{$prev_stop} )
			{
				return $platform_info->{direction_from}{$prev_stop};
			}
			elsif ( $next_stop
				and exists $platform_info->{direction_from}{$next_stop} )
			{
				return $platform_info->{direction_from}{$next_stop} eq 'r'
				  ? 'l'
				  : 'r';
			}
			elsif ($wagonorder) {
				my $wr;
				eval {
					$wr
					  = Travel::Status::DE::DBWagenreihung->new(
						from_json => $wagonorder );
				};
				if (    $wr
					and $wr->sections
					and defined $wr->direction )
				{
					my $section_0 = ( $wr->sections )[0];
					my $direction = $wr->direction;
					if (    $section_0->name eq 'A'
						and $direction == 0 )
					{
						return $platform_info->{direction};
					}
					elsif ( $section_0->name ne 'A'
						and $direction == 100 )
					{
						return $platform_info->{direction};
					}
					elsif ( $platform_info->{direction} ) {
						return $platform_info->{direction} eq 'r'
						  ? 'l'
						  : 'r';
					}
					return;
				}
			}
		}
	);

	$self->helper(
		'journey_to_ajax_route' => sub {
			my ( $self, $journey ) = @_;

			my @route;

			for my $station ( @{ $journey->{route_after} } ) {
				my $station_desc = $station->[0];
				if ( $station->[1]{rt_arr} ) {
					$station_desc .= $station->[1]{sched_arr}->strftime(';%s');
					$station_desc .= $station->[1]{rt_arr}->strftime(';%s');
					if ( $station->[1]{rt_dep} ) {
						$station_desc
						  .= $station->[1]{sched_dep}->strftime(';%s');
						$station_desc .= $station->[1]{rt_dep}->strftime(';%s');
					}
					else {
						$station_desc .= ';0;0';
					}
				}
				else {
					$station_desc .= ';0;0;0;0';
				}
				push( @route, $station_desc );
			}

			return join( '|', @route );
		}
	);

	$self->helper(
		'get_user_status' => sub {
			my ( $self, $uid ) = @_;

			$uid //= $self->current_user->{id};

			my $db    = $self->pg->db;
			my $now   = DateTime->now( time_zone => 'Europe/Berlin' );
			my $epoch = $now->epoch;

			my $in_transit
			  = $db->select( 'in_transit_str', '*', { user_id => $uid } )
			  ->expand->hash;

			if ($in_transit) {

				if ( my $station
					= $self->app->station_by_eva->{ $in_transit->{dep_eva} } )
				{
					$in_transit->{dep_ds100} = $station->[0];
					$in_transit->{dep_name}  = $station->[1];
				}
				if ( $in_transit->{arr_eva}
					and my $station
					= $self->app->station_by_eva->{ $in_transit->{arr_eva} } )
				{
					$in_transit->{arr_ds100} = $station->[0];
					$in_transit->{arr_name}  = $station->[1];
				}

				my @route = @{ $in_transit->{route} // [] };
				my @route_after;
				my $dep_info;
				my $stop_before_dest;
				my $is_after = 0;
				for my $station (@route) {

					if (    $in_transit->{arr_name}
						and @route_after
						and $station->[0] eq $in_transit->{arr_name} )
					{
						$stop_before_dest = $route_after[-1][0];
					}
					if ($is_after) {
						push( @route_after, $station );
					}
					if (    $in_transit->{dep_name}
						and $station->[0] eq $in_transit->{dep_name} )
					{
						$is_after = 1;
						if ( @{$station} > 1 ) {
							$dep_info = $station->[1];
						}
					}
				}
				my $stop_after_dep = @route_after ? $route_after[0][0] : undef;

				my $ts = $in_transit->{checkout_ts}
				  // $in_transit->{checkin_ts};
				my $action_time = epoch_to_dt($ts);

				my $ret = {
					checked_in         => !$in_transit->{cancelled},
					cancelled          => $in_transit->{cancelled},
					timestamp          => $action_time,
					timestamp_delta    => $now->epoch - $action_time->epoch,
					train_type         => $in_transit->{train_type},
					train_line         => $in_transit->{train_line},
					train_no           => $in_transit->{train_no},
					train_id           => $in_transit->{train_id},
					boarding_countdown => -1,
					sched_departure =>
					  epoch_to_dt( $in_transit->{sched_dep_ts} ),
					real_departure => epoch_to_dt( $in_transit->{real_dep_ts} ),
					dep_ds100      => $in_transit->{dep_ds100},
					dep_eva        => $in_transit->{dep_eva},
					dep_name       => $in_transit->{dep_name},
					dep_platform   => $in_transit->{dep_platform},
					sched_arrival => epoch_to_dt( $in_transit->{sched_arr_ts} ),
					real_arrival  => epoch_to_dt( $in_transit->{real_arr_ts} ),
					arr_ds100     => $in_transit->{arr_ds100},
					arr_eva       => $in_transit->{arr_eva},
					arr_name      => $in_transit->{arr_name},
					arr_platform  => $in_transit->{arr_platform},
					route_after   => \@route_after,
					messages      => $in_transit->{messages},
					extra_data    => $in_transit->{data},
					comment       => $in_transit->{user_data}{comment},
				};

				my @parsed_messages;
				for my $message ( @{ $ret->{messages} // [] } ) {
					my ( $ts, $msg ) = @{$message};
					push( @parsed_messages, [ epoch_to_dt($ts), $msg ] );
				}
				$ret->{messages} = [ reverse @parsed_messages ];

				@parsed_messages = ();
				for my $message ( @{ $ret->{extra_data}{qos_msg} // [] } ) {
					my ( $ts, $msg ) = @{$message};
					push( @parsed_messages, [ epoch_to_dt($ts), $msg ] );
				}
				$ret->{extra_data}{qos_msg} = [@parsed_messages];

				if ( $dep_info and $dep_info->{sched_arr} ) {
					$dep_info->{sched_arr}
					  = epoch_to_dt( $dep_info->{sched_arr} );
					$dep_info->{rt_arr} = $dep_info->{sched_arr}->clone;
					if (    $dep_info->{adelay}
						and $dep_info->{adelay} =~ m{^\d+$} )
					{
						$dep_info->{rt_arr}
						  ->add( minutes => $dep_info->{adelay} );
					}
					$dep_info->{rt_arr_countdown} = $ret->{boarding_countdown}
					  = $dep_info->{rt_arr}->epoch - $epoch;
				}

				for my $station (@route_after) {
					if ( @{$station} > 1 ) {

						# Note: $station->[1]{sched_arr} may already have been
						# converted to a DateTime object in $station->[1] is
						# $dep_info. This can happen when a station is present
						# several times in a train's route, e.g. for Frankfurt
						# Flughafen in some nightly connections.
						my $times = $station->[1];
						if ( $times->{sched_arr}
							and ref( $times->{sched_arr} ) ne 'DateTime' )
						{
							$times->{sched_arr}
							  = epoch_to_dt( $times->{sched_arr} );
							$times->{rt_arr} = $times->{sched_arr}->clone;
							if (    $times->{adelay}
								and $times->{adelay} =~ m{^\d+$} )
							{
								$times->{rt_arr}
								  ->add( minutes => $times->{adelay} );
							}
							$times->{rt_arr_countdown}
							  = $times->{rt_arr}->epoch - $epoch;
						}
						if ( $times->{sched_dep}
							and ref( $times->{sched_dep} ) ne 'DateTime' )
						{
							$times->{sched_dep}
							  = epoch_to_dt( $times->{sched_dep} );
							$times->{rt_dep} = $times->{sched_dep}->clone;
							if (    $times->{ddelay}
								and $times->{ddelay} =~ m{^\d+$} )
							{
								$times->{rt_dep}
								  ->add( minutes => $times->{ddelay} );
							}
							$times->{rt_dep_countdown}
							  = $times->{rt_dep}->epoch - $epoch;
						}
					}
				}

				$ret->{departure_countdown}
				  = $ret->{real_departure}->epoch - $now->epoch;

				if (    $ret->{departure_countdown} > 0
					and $in_transit->{data}{wagonorder_dep} )
				{
					my $wr;
					eval {
						$wr
						  = Travel::Status::DE::DBWagenreihung->new(
							from_json => $in_transit->{data}{wagonorder_dep} );
					};
					if (    $wr
						and $wr->sections
						and $wr->wagons
						and defined $wr->direction )
					{
						$ret->{wagonorder} = $wr;
					}
				}

				if ( $in_transit->{real_arr_ts} ) {
					$ret->{arrival_countdown}
					  = $ret->{real_arrival}->epoch - $now->epoch;
					$ret->{journey_duration}
					  = $ret->{real_arrival}->epoch
					  - $ret->{real_departure}->epoch;
					$ret->{journey_completion}
					  = $ret->{journey_duration}
					  ? 1
					  - ( $ret->{arrival_countdown} / $ret->{journey_duration} )
					  : 1;
					if ( $ret->{journey_completion} > 1 ) {
						$ret->{journey_completion} = 1;
					}
					elsif ( $ret->{journey_completion} < 0 ) {
						$ret->{journey_completion} = 0;
					}

					my ($dep_platform_number)
					  = ( ( $ret->{dep_platform} // 0 ) =~ m{(\d+)} );
					if ( $dep_platform_number
						and exists $in_transit->{data}{stationinfo_dep}
						{$dep_platform_number} )
					{
						$ret->{dep_direction}
						  = $self->stationinfo_to_direction(
							$in_transit->{data}{stationinfo_dep}
							  {$dep_platform_number},
							$in_transit->{data}{wagonorder_dep},
							undef,
							$stop_after_dep
						  );
					}

					my ($arr_platform_number)
					  = ( ( $ret->{arr_platform} // 0 ) =~ m{(\d+)} );
					if ( $arr_platform_number
						and exists $in_transit->{data}{stationinfo_arr}
						{$arr_platform_number} )
					{
						$ret->{arr_direction}
						  = $self->stationinfo_to_direction(
							$in_transit->{data}{stationinfo_arr}
							  {$arr_platform_number},
							$in_transit->{data}{wagonorder_arr},
							$stop_before_dest,
							undef
						  );
					}

				}
				else {
					$ret->{arrival_countdown}  = undef;
					$ret->{journey_duration}   = undef;
					$ret->{journey_completion} = undef;
				}

				return $ret;
			}

			my $latest = $db->select(
				'journeys_str',
				'*',
				{
					user_id   => $uid,
					cancelled => 0
				},
				{
					order_by => { -desc => 'journey_id' },
					limit    => 1
				}
			)->expand->hash;

			my $latest_cancellation = $db->select(
				'journeys_str',
				'*',
				{
					user_id => $uid,
				},
				{
					order_by => { -desc => 'journey_id' },
					limit    => 1
				}
			)->expand->hash;

			if ( $latest_cancellation and $latest_cancellation->{cancelled} ) {
				if ( my $station
					= $self->app->station_by_eva
					->{ $latest_cancellation->{dep_eva} } )
				{
					$latest_cancellation->{dep_ds100} = $station->[0];
					$latest_cancellation->{dep_name}  = $station->[1];
				}
				if ( my $station
					= $self->app->station_by_eva
					->{ $latest_cancellation->{arr_eva} } )
				{
					$latest_cancellation->{arr_ds100} = $station->[0];
					$latest_cancellation->{arr_name}  = $station->[1];
				}
			}
			else {
				$latest_cancellation = undef;
			}

			if ($latest) {
				my $ts          = $latest->{checkout_ts};
				my $action_time = epoch_to_dt($ts);
				if ( my $station
					= $self->app->station_by_eva->{ $latest->{dep_eva} } )
				{
					$latest->{dep_ds100} = $station->[0];
					$latest->{dep_name}  = $station->[1];
				}
				if ( my $station
					= $self->app->station_by_eva->{ $latest->{arr_eva} } )
				{
					$latest->{arr_ds100} = $station->[0];
					$latest->{arr_name}  = $station->[1];
				}
				return {
					checked_in      => 0,
					cancelled       => 0,
					cancellation    => $latest_cancellation,
					journey_id      => $latest->{journey_id},
					timestamp       => $action_time,
					timestamp_delta => $now->epoch - $action_time->epoch,
					train_type      => $latest->{train_type},
					train_line      => $latest->{train_line},
					train_no        => $latest->{train_no},
					train_id        => $latest->{train_id},
					sched_departure => epoch_to_dt( $latest->{sched_dep_ts} ),
					real_departure  => epoch_to_dt( $latest->{real_dep_ts} ),
					dep_ds100       => $latest->{dep_ds100},
					dep_eva         => $latest->{dep_eva},
					dep_name        => $latest->{dep_name},
					dep_platform    => $latest->{dep_platform},
					sched_arrival   => epoch_to_dt( $latest->{sched_arr_ts} ),
					real_arrival    => epoch_to_dt( $latest->{real_arr_ts} ),
					arr_ds100       => $latest->{arr_ds100},
					arr_eva         => $latest->{arr_eva},
					arr_name        => $latest->{arr_name},
					arr_platform    => $latest->{arr_platform},
					comment         => $latest->{user_data}{comment},
				};
			}

			return {
				checked_in      => 0,
				cancelled       => 0,
				cancellation    => $latest_cancellation,
				no_journeys_yet => 1,
				timestamp       => epoch_to_dt(0),
				timestamp_delta => $now->epoch,
			};
		}
	);

	$self->helper(
		'get_user_status_json_v1' => sub {
			my ( $self, $uid ) = @_;
			my $status = $self->get_user_status($uid);

			# TODO simplify lon/lat (can be returned from get_user_status)

			my $ret = {
				deprecated => \0,
				checkedIn  => (
					     $status->{checked_in}
					  or $status->{cancelled}
				) ? \1 : \0,
				fromStation => {
					ds100         => $status->{dep_ds100},
					name          => $status->{dep_name},
					uic           => $status->{dep_eva},
					longitude     => undef,
					latitude      => undef,
					scheduledTime => $status->{sched_departure}
					? $status->{sched_departure}->epoch
					: undef,
					realTime => $status->{real_departure}
					? $status->{real_departure}->epoch
					: undef,
				},
				toStation => {
					ds100         => $status->{arr_ds100},
					name          => $status->{arr_name},
					uic           => $status->{arr_eva},
					longitude     => undef,
					latitude      => undef,
					scheduledTime => $status->{sched_arrival}
					? $status->{sched_arrival}->epoch
					: undef,
					realTime => $status->{real_arrival}
					? $status->{real_arrival}->epoch
					: undef,
				},
				train => {
					type => $status->{train_type},
					line => $status->{train_line},
					no   => $status->{train_no},
					id   => $status->{train_id},
				},
				actionTime => $status->{timestamp}
				? $status->{timestamp}->epoch
				: undef,
				intermediateStops => [],
			};

			for my $stop ( @{ $status->{route_after} // [] } ) {
				if ( $status->{arr_name} and $stop->[0] eq $status->{arr_name} )
				{
					last;
				}
				push(
					@{ $ret->{intermediateStops} },
					{
						name             => $stop->[0],
						scheduledArrival => $stop->[1]{sched_arr}
						? $stop->[1]{sched_arr}->epoch
						: undef,
						realArrival => $stop->[1]{rt_arr}
						? $stop->[1]{rt_arr}->epoch
						: undef,
						scheduledDeparture => $stop->[1]{sched_dep}
						? $stop->[1]{sched_dep}->epoch
						: undef,
						realDeparture => $stop->[1]{rt_dep}
						? $stop->[1]{rt_dep}->epoch
						: undef,
					}
				);
			}

			if ( $status->{dep_eva} ) {
				my @station_descriptions
				  = Travel::Status::DE::IRIS::Stations::get_station(
					$status->{dep_eva} );
				if ( @station_descriptions == 1 ) {
					(
						undef, undef, undef,
						$ret->{fromStation}{longitude},
						$ret->{fromStation}{latitude}
					) = @{ $station_descriptions[0] };
				}
			}

			if ( $status->{arr_ds100} ) {
				my @station_descriptions
				  = Travel::Status::DE::IRIS::Stations::get_station(
					$status->{arr_ds100} );
				if ( @station_descriptions == 1 ) {
					(
						undef, undef, undef,
						$ret->{toStation}{longitude},
						$ret->{toStation}{latitude}
					) = @{ $station_descriptions[0] };
				}
			}

			return $ret;
		}
	);

	$self->helper(
		'journeys_to_map_data' => sub {
			my ( $self, %opt ) = @_;

			my @journeys       = @{ $opt{journeys} // [] };
			my $route_type     = $opt{route_type} // 'polybee';
			my $include_manual = $opt{include_manual} ? 1 : 0;

			my $location = $self->app->coordinates_by_station;

			my $with_polyline = $route_type eq 'beeline' ? 0 : 1;

			if ( not @journeys ) {
				return {
					skipped_journeys    => [],
					station_coordinates => [],
					polyline_groups     => [],
				};
			}

			my $json = JSON->new->utf8;

			my $first_departure = $journeys[-1]->{rt_departure};
			my $last_departure  = $journeys[0]->{rt_departure};

			my @stations = List::Util::uniq map { $_->{to_name} } @journeys;
			push( @stations,
				List::Util::uniq map { $_->{from_name} } @journeys );
			@stations = List::Util::uniq @stations;
			my @station_coordinates = map { [ $location->{$_}, $_ ] }
			  grep { exists $location->{$_} } @stations;

			my @station_pairs;
			my @polylines;
			my %seen;

			my @skipped_journeys;
			my @polyline_journeys = grep { $_->{polyline} } @journeys;
			my @beeline_journeys  = grep { not $_->{polyline} } @journeys;

			if ( $route_type eq 'polyline' ) {
				@beeline_journeys = ();
			}
			elsif ( $route_type eq 'beeline' ) {
				push( @beeline_journeys, @polyline_journeys );
				@polyline_journeys = ();
			}

			for my $journey (@polyline_journeys) {
				my @polyline = @{ $journey->{polyline} };
				my $from_eva = $journey->{from_eva};
				my $to_eva   = $journey->{to_eva};

				my $from_index
				  = first_index { $_->[2] and $_->[2] == $from_eva } @polyline;
				my $to_index
				  = first_index { $_->[2] and $_->[2] == $to_eva } @polyline;

				if (   $from_index == -1
					or $to_index == -1 )
				{
					# Fall back to route
					delete $journey->{polyline};
					next;
				}

				my $key
				  = $from_eva . '!'
				  . $to_eva . '!'
				  . ( $to_index - $from_index );

				if ( $seen{$key} ) {
					next;
				}

				$seen{$key} = 1;

				# direction does not matter at the moment
				$key
				  = $to_eva . '!'
				  . $from_eva . '!'
				  . ( $to_index - $from_index );
				$seen{$key} = 1;

				@polyline = @polyline[ $from_index .. $to_index ];
				my @polyline_coords;
				for my $coord (@polyline) {
					push( @polyline_coords, [ $coord->[1], $coord->[0] ] );
				}
				push( @polylines, [@polyline_coords] );
			}

			for my $journey (@beeline_journeys) {

				my @route = map { $_->[0] } @{ $journey->{route} };

				my $from_index
				  = first_index { $_ eq $journey->{from_name} } @route;
				my $to_index = first_index { $_ eq $journey->{to_name} } @route;

				if ( $from_index == -1 ) {
					my $rename = $self->app->renamed_station;
					$from_index = first_index {
						( $rename->{$_} // $_ ) eq $journey->{from_name}
					}
					@route;
				}
				if ( $to_index == -1 ) {
					my $rename = $self->app->renamed_station;
					$to_index = first_index {
						( $rename->{$_} // $_ ) eq $journey->{to_name}
					}
					@route;
				}

				if (   $from_index == -1
					or $to_index == -1 )
				{
					push( @skipped_journeys,
						[ $journey, 'Start/Ziel nicht in Route gefunden' ] );
					next;
				}

          # Manual journey entries are only included if one of the following
          # conditions is satisfied:
          # * their route has more than two elements (-> probably more than just
          #   start and stop station), or
          # * $include_manual is true (-> user wants to see incomplete routes)
          # This avoids messing up the map in case an A -> B connection has been
          # tracked both with a regular checkin (-> detailed route shown on map)
          # and entered manually (-> beeline also shown on map, typically
          # significantly differs from detailed route) -- unless the user
          # sets include_manual, of course.
				if (    $journey->{edited} & 0x0010
					and @route <= 2
					and not $include_manual )
				{
					push( @skipped_journeys,
						[ $journey, 'Manueller Eintrag ohne Unterwegshalte' ] );
					next;
				}

				@route = @route[ $from_index .. $to_index ];

				my $key = join( '|', @route );

				if ( $seen{$key} ) {
					next;
				}

				$seen{$key} = 1;

				# direction does not matter at the moment
				$seen{ join( '|', reverse @route ) } = 1;

				my $prev_station = shift @route;
				for my $station (@route) {
					push( @station_pairs, [ $prev_station, $station ] );
					$prev_station = $station;
				}
			}

			@station_pairs = uniq_by { $_->[0] . '|' . $_->[1] } @station_pairs;
			@station_pairs = grep {
				      exists $location->{ $_->[0] }
				  and exists $location->{ $_->[1] }
			} @station_pairs;
			@station_pairs
			  = map { [ $location->{ $_->[0] }, $location->{ $_->[1] } ] }
			  @station_pairs;

			my $ret = {
				skipped_journeys    => \@skipped_journeys,
				station_coordinates => \@station_coordinates,
				polyline_groups     => [
					{
						polylines => $json->encode( \@station_pairs ),
						color     => '#673ab7',
						opacity   => $with_polyline ? 0.4 : 0.6,
					},
					{
						polylines => $json->encode( \@polylines ),
						color     => '#673ab7',
						opacity   => 0.8,
					}
				],
			};

			if (@station_coordinates) {
				my @lats = map { $_->[0][0] } @station_coordinates;
				my @lons = map { $_->[0][1] } @station_coordinates;
				my $min_lat = List::Util::min @lats;
				my $max_lat = List::Util::max @lats;
				my $min_lon = List::Util::min @lons;
				my $max_lon = List::Util::max @lons;
				$ret->{bounds}
				  = [ [ $min_lat, $min_lon ], [ $max_lat, $max_lon ] ];
			}

			return $ret;
		}
	);

	$self->helper(
		'compute_journey_stats' => sub {
			my ( $self, @journeys ) = @_;
			my $km_route         = 0;
			my $km_beeline       = 0;
			my $min_travel_sched = 0;
			my $min_travel_real  = 0;
			my $delay_dep        = 0;
			my $delay_arr        = 0;
			my $interchange_real = 0;
			my $num_trains       = 0;
			my $num_journeys     = 0;
			my @inconsistencies;

			my $next_departure = 0;

			for my $journey (@journeys) {
				$num_trains++;
				$km_route   += $journey->{km_route};
				$km_beeline += $journey->{km_beeline};
				if (    $journey->{sched_duration}
					and $journey->{sched_duration} > 0 )
				{
					$min_travel_sched += $journey->{sched_duration} / 60;
				}
				if ( $journey->{rt_duration} and $journey->{rt_duration} > 0 ) {
					$min_travel_real += $journey->{rt_duration} / 60;
				}
				if ( $journey->{sched_dep_ts} and $journey->{rt_dep_ts} ) {
					$delay_dep
					  += ( $journey->{rt_dep_ts} - $journey->{sched_dep_ts} )
					  / 60;
				}
				if ( $journey->{sched_arr_ts} and $journey->{rt_arr_ts} ) {
					$delay_arr
					  += ( $journey->{rt_arr_ts} - $journey->{sched_arr_ts} )
					  / 60;
				}

				# Note that journeys are sorted from recent to older entries
				if (    $journey->{rt_arr_ts}
					and $next_departure
					and $next_departure - $journey->{rt_arr_ts} < ( 60 * 60 ) )
				{
					if ( $next_departure - $journey->{rt_arr_ts} < 0 ) {
						push( @inconsistencies,
							epoch_to_dt($next_departure)
							  ->strftime('%d.%m.%Y %H:%M') );
					}
					else {
						$interchange_real
						  += ( $next_departure - $journey->{rt_arr_ts} ) / 60;
					}
				}
				else {
					$num_journeys++;
				}
				$next_departure = $journey->{rt_dep_ts};
			}
			return {
				km_route             => $km_route,
				km_beeline           => $km_beeline,
				num_trains           => $num_trains,
				num_journeys         => $num_journeys,
				min_travel_sched     => $min_travel_sched,
				min_travel_real      => $min_travel_real,
				min_interchange_real => $interchange_real,
				delay_dep            => $delay_dep,
				delay_arr            => $delay_arr,
				inconsistencies      => \@inconsistencies,
			};
		}
	);

	$self->helper(
		'navbar_class' => sub {
			my ( $self, $path ) = @_;

			if ( $self->req->url eq $self->url_for($path) ) {
				return 'active';
			}
			return q{};
		}
	);

	my $r = $self->routes;

	$r->get('/')->to('traveling#homepage');
	$r->get('/about')->to('static#about');
	$r->get('/api')->to('api#documentation');
	$r->get('/changelog')->to('static#changelog');
	$r->get('/impressum')->to('static#imprint');
	$r->get('/imprint')->to('static#imprint');
	$r->get('/offline')->to('static#offline');
	$r->get('/api/v1/:user_action/:token')->to('api#get_v1');
	$r->get('/login')->to('account#login_form');
	$r->get('/recover')->to('account#request_password_reset');
	$r->get('/recover/:id/:token')->to('account#recover_password');
	$r->get('/register')->to('account#registration_form');
	$r->get('/reg/:id/:token')->to('account#verify');
	$r->get('/status/:name')->to('traveling#user_status');
	$r->get('/status/:name/:ts')->to('traveling#user_status');
	$r->get('/ajax/status/:name')->to('traveling#public_status_card');
	$r->get('/ajax/status/:name/:ts')->to('traveling#public_status_card');
	$r->get('/p/:name')->to('traveling#public_profile');
	$r->get('/p/:name/j/:id')->to('traveling#public_journey_details');
	$r->post('/api/v1/import')->to('api#import_v1');
	$r->post('/api/v1/travel')->to('api#travel_v1');
	$r->post('/action')->to('traveling#log_action');
	$r->post('/geolocation')->to('traveling#geolocation');
	$r->post('/list_departures')->to('traveling#redirect_to_station');
	$r->post('/login')->to('account#do_login');
	$r->post('/register')->to('account#register');
	$r->post('/recover')->to('account#request_password_reset');

	my $authed_r = $r->under(
		sub {
			my ($self) = @_;
			if ( $self->is_user_authenticated ) {
				return 1;
			}
			$self->render( 'login', redirect_to => $self->req->url );
			return undef;
		}
	);

	$authed_r->get('/account')->to('account#account');
	$authed_r->get('/account/privacy')->to('account#privacy');
	$authed_r->get('/account/hooks')->to('account#webhook');
	$authed_r->get('/account/insight')->to('account#insight');
	$authed_r->get('/ajax/status_card.html')->to('traveling#status_card');
	$authed_r->get('/cancelled')->to('traveling#cancelled');
	$authed_r->get('/fgr')->to('passengerrights#list_candidates');
	$authed_r->get('/account/password')->to('account#password_form');
	$authed_r->get('/account/mail')->to('account#change_mail');
	$authed_r->get('/export.json')->to('account#json_export');
	$authed_r->get('/history.json')->to('traveling#json_history');
	$authed_r->get('/history.csv')->to('traveling#csv_history');
	$authed_r->get('/history')->to('traveling#history');
	$authed_r->get('/history/commute')->to('traveling#commute');
	$authed_r->get('/history/map')->to('traveling#map_history');
	$authed_r->get('/history/:year')->to('traveling#yearly_history');
	$authed_r->get('/history/:year/:month')->to('traveling#monthly_history');
	$authed_r->get('/journey/add')->to('traveling#add_journey_form');
	$authed_r->get('/journey/comment')->to('traveling#comment_form');
	$authed_r->get('/journey/:id')->to('traveling#journey_details');
	$authed_r->get('/s/*station')->to('traveling#station');
	$authed_r->get('/confirm_mail/:token')->to('account#confirm_mail');
	$authed_r->post('/account/privacy')->to('account#privacy');
	$authed_r->post('/account/hooks')->to('account#webhook');
	$authed_r->post('/account/insight')->to('account#insight');
	$authed_r->post('/journey/add')->to('traveling#add_journey_form');
	$authed_r->post('/journey/comment')->to('traveling#comment_form');
	$authed_r->post('/journey/edit')->to('traveling#edit_journey');
	$authed_r->post('/journey/passenger_rights/*filename')
	  ->to('passengerrights#generate');
	$authed_r->post('/account/password')->to('account#change_password');
	$authed_r->post('/account/mail')->to('account#change_mail');
	$authed_r->post('/delete')->to('account#delete');
	$authed_r->post('/logout')->to('account#do_logout');
	$authed_r->post('/set_token')->to('api#set_token');

}

1;