move statistics cache to a separate model class

2 files changed, 269 insertions, 36 deletions

diff --git a/lib/Travelynx/Model/JourneyStatsCache.pm b/lib/Travelynx/Model/JourneyStatsCache.pm
new file mode 100755
index 0000000..145208d
--- /dev/null
+++ b/lib/Travelynx/Model/JourneyStatsCache.pm
@@ -0,0 +1,100 @@
+package Travelynx::Model::JourneyStatsCache;
+# Copyright (C) 2020 Daniel Friesel
+#
+# SPDX-License-Identifier: MIT
+
+use strict;
+use warnings;
+use 5.020;
+use utf8;
+
+import JSON;
+
+sub new {
+	my ( $class, %opt ) = @_;
+
+	return bless( \%opt, $class );
+}
+
+sub add {
+	my ( $self, %opt ) = @_;
+
+	my $db  = $opt{db} // $self->{pg}->db;
+
+	eval {
+		$db->insert(
+			'journey_stats',
+			{
+				user_id => $opt{uid},
+				year    => $opt{year},
+				month   => $opt{month},
+				data    => JSON->new->encode($opt{stats}),
+			}
+		);
+	};
+	if ( my $err = $@ ) {
+		if ( $err =~ m{duplicate key value violates unique constraint} )
+		{
+				# If 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($@);
+		}
+	}
+}
+
+sub get {
+	my ( $self, %opt ) = @_;
+
+	my $db  = $opt{db} // $self->{pg}->db;
+
+	my $stats = $db->select(
+		'journey_stats',
+		['data'],
+		{
+			user_id => $opt{uid},
+			year    => $opt{year},
+			month   => $opt{month}
+		}
+	)->expand->hash;
+
+	return $stats->{data};
+}
+
+# Statistics are partitioned by real_departure, which must be provided
+# when calling this function e.g. after journey deletion or editing.
+# If a joureny's real_departure has been edited, this function must be
+# called twice: once with the old and once with the new value.
+sub invalidate {
+	my ( $self, %opt ) = @_;
+
+	my $ts  = $opt{ts};
+	my $db  = $opt{db} // $self->{pg}->db;
+	my $uid = $opt{uid};
+
+	$db->delete(
+		'journey_stats',
+		{
+			user_id => $uid,
+			year    => $ts->year,
+			month   => $ts->month,
+		}
+	);
+	$db->delete(
+		'journey_stats',
+		{
+			user_id => $uid,
+			year    => $ts->year,
+			month   => 0,
+		}
+	);
+}
+
+1;
diff --git a/lib/Travelynx/Model/Journeys.pm b/lib/Travelynx/Model/Journeys.pm
index 3a6afd5..f5f5424 100755
--- a/lib/Travelynx/Model/Journeys.pm
+++ b/lib/Travelynx/Model/Journeys.pm
@@ -1,4 +1,5 @@
 package Travelynx::Model::Journeys;
+
 # Copyright (C) 2020 Daniel Friesel
 #
 # SPDX-License-Identifier: MIT
@@ -85,6 +86,11 @@ sub new {
 	return bless( \%opt, $class );
 }
 
+sub stats_cache {
+	my ($self) = @_;
+	return $self->{stats_cache};
+}
+
 # Returns (journey id, error)
 # Must be called during a transaction.
 # Must perform a rollback on error.
@@ -191,7 +197,7 @@ sub add {
 		$journey_id
 		  = $db->insert( 'journeys', $entry, { returning => 'id' } )
 		  ->hash->{id};
-		$self->invalidate_stats_cache(
+		$self->stats_cache->invalidate(
 			ts  => $opt{rt_departure},
 			db  => $db,
 			uid => $uid
@@ -294,7 +300,7 @@ sub update {
 			# stats are partitioned by rt_departure -> both the cache for
 			# the old value (see bottom of this function) and the new value
 			# (here) must be invalidated.
-			$self->invalidate_stats_cache(
+			$self->stats_cache->invalidate(
 				ts  => $opt{rt_departure},
 				db  => $db,
 				uid => $uid,
@@ -371,7 +377,7 @@ sub update {
 		return "update($journey_id): $@";
 	}
 	if ( $rows == 1 ) {
-		$self->invalidate_stats_cache(
+		$self->stats_cache->invalidate(
 			ts  => $journey->{rt_departure},
 			db  => $db,
 			uid => $uid,
@@ -426,7 +432,7 @@ sub delete {
 	}
 
 	if ( $rows == 1 ) {
-		$self->invalidate_stats_cache(
+		$self->stats_cache->invalidate(
 			ts  => epoch_to_dt( $journey->{rt_dep_ts} ),
 			uid => $uid
 		);
@@ -743,18 +749,15 @@ sub get_months_for_year {
 		if ( $row->{year} == $year ) {
 
 			# TODO delegate query to the (not yet present) JourneyStats model
-			my $stats = $db->select(
-				'journey_stats',
-				['data'],
-				{
-					user_id => $uid,
-					year    => $year,
-					month   => $row->{month}
-				}
-			)->expand->hash;
+			my $stats = $self->stats_cache->get(
+				db    => $db,
+				uid   => $uid,
+				year  => $year,
+				month => $row->{month}
+			);
 
 			# undef -> no journeys for this month; empty hash -> no cached stats
-			$ret[ $row->{month} - 1 ][2] = $stats->{data} // {};
+			$ret[ $row->{month} - 1 ][2] = $stats // {};
 		}
 	}
 	return @ret;
@@ -943,33 +946,163 @@ sub get_travel_distance {
 		$distance_beeline, $skipped );
 }
 
-# Statistics are partitioned by real_departure, which must be provided
-# when calling this function e.g. after journey deletion or editing.
-# If a joureny's real_departure has been edited, this function must be
-# called twice: once with the old and once with the new value.
-sub invalidate_stats_cache {
-	my ( $self, %opt ) = @_;
-
-	my $ts  = $opt{ts};
-	my $db  = $opt{db} // $self->{pg}->db;
-	my $uid = $opt{uid};
-
-	$db->delete(
-		'journey_stats',
+sub compute_stats {
+	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 )
 		{
-			user_id => $uid,
-			year    => $ts->year,
-			month   => $ts->month,
+			$min_travel_sched += $journey->{sched_duration} / 60;
 		}
-	);
-	$db->delete(
-		'journey_stats',
+		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 ) )
 		{
-			user_id => $uid,
-			year    => $ts->year,
-			month   => 0,
+			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};
+	}
+	my $ret = {
+		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,
+	};
+	for my $key (
+		qw(min_travel_sched min_travel_real min_interchange_real delay_dep delay_arr)
+	  )
+	{
+		my $strf_key = $key . '_strf';
+		my $value    = $ret->{$key};
+		$ret->{$strf_key} = q{};
+		if ( $ret->{$key} < 0 ) {
+			$ret->{$strf_key} .= '-';
+			$value *= -1;
+		}
+		$ret->{$strf_key} .= sprintf( '%02d:%02d', $value / 60, $value % 60 );
+	}
+	return $ret;
+}
+
+sub get_stats {
+	my ( $self, %opt ) = @_;
+
+	if ( $opt{cancelled} ) {
+		$self->{log}
+		  ->warn('get_journey_stats called with illegal option cancelled => 1');
+		return {};
+	}
+
+	my $uid   = $opt{uid};
+	my $db    = $opt{db} // $self->{pg}->db;
+	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.
+
+	if (
+		my $stats = $self->stats_cache->get(
+			uid   => $uid,
+			db    => $db,
+			year  => $year,
+			month => $month
+		)
+	  )
+	{
+		return $stats;
+	}
+
+	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->get(
+		uid           => $uid,
+		cancelled     => $opt{cancelled} ? 1 : 0,
+		verbose       => 1,
+		with_polyline => 1,
+		after         => $interval_start,
+		before        => $interval_end
+	);
+	my $stats = $self->compute_stats(@journeys);
+
+	$self->stats_cache->add(
+		uid   => $uid,
+		db    => $db,
+		year  => $year,
+		month => $month,
+		stats => $stats
 	);
+
+	return $stats;
 }
 
 1;