move statistics cache to a separate model class

6 files changed, 296 insertions, 234 deletions

diff --git a/lib/Travelynx.pm b/lib/Travelynx.pm
index 551dbc9..edb4637 100755
--- a/lib/Travelynx.pm
+++ b/lib/Travelynx.pm
@@ -1,4 +1,5 @@
 package Travelynx;
+
 # Copyright (C) 2020 Daniel Friesel
 #
 # SPDX-License-Identifier: MIT
@@ -27,6 +28,7 @@ use Travelynx::Helper::Sendmail;
 use Travelynx::Helper::Traewelling;
 use Travelynx::Model::InTransit;
 use Travelynx::Model::Journeys;
+use Travelynx::Model::JourneyStatsCache;
 use Travelynx::Model::Traewelling;
 use Travelynx::Model::Users;
 use XML::LibXML;
@@ -330,11 +332,23 @@ sub startup {
 	);
 
 	$self->helper(
+		journey_stats_cache => sub {
+			my ($self) = @_;
+			state $journey_stats_cache
+			  = Travelynx::Model::JourneyStatsCache->new(
+				log => $self->app->log,
+				pg  => $self->pg,
+			  );
+		}
+	);
+
+	$self->helper(
 		journeys => sub {
 			my ($self) = @_;
 			state $journeys = Travelynx::Model::Journeys->new(
 				log             => $self->app->log,
 				pg              => $self->pg,
+				stats_cache     => $self->journey_stats_cache,
 				renamed_station => $self->app->renamed_station,
 				station_by_eva  => $self->app->station_by_eva,
 			);
@@ -546,7 +560,7 @@ sub startup {
 					);
 				}
 
-				$self->journeys->invalidate_stats_cache(
+				$self->journey_stats_cache->invalidate(
 					ts  => $cache_ts,
 					db  => $db,
 					uid => $uid
@@ -756,7 +770,7 @@ sub startup {
 							month => $+{month}
 						);
 					}
-					$self->journeys->invalidate_stats_cache(
+					$self->journey_stats_cache->invalidate(
 						ts  => $cache_ts,
 						db  => $db,
 						uid => $uid
@@ -970,109 +984,6 @@ sub startup {
 	);
 
 	$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(
 		'add_route_timestamps' => sub {
 			my ( $self, $uid, $train, $is_departure ) = @_;
 
@@ -2546,95 +2457,6 @@ sub startup {
 	);
 
 	$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};
-			}
-			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;
-		}
-	);
-
-	$self->helper(
 		'navbar_class' => sub {
 			my ( $self, $path ) = @_;
 
diff --git a/lib/Travelynx/Command/work.pm b/lib/Travelynx/Command/work.pm
index f9b78b6..16b41b2 100644
--- a/lib/Travelynx/Command/work.pm
+++ b/lib/Travelynx/Command/work.pm
@@ -1,4 +1,5 @@
 package Travelynx::Command::work;
+
 # Copyright (C) 2020 Daniel Friesel
 #
 # SPDX-License-Identifier: MIT
@@ -293,7 +294,7 @@ sub run {
 	# own by-year journey log.
 	for my $user ( $db->select( 'users', 'id', { status => 1 } )->hashes->each )
 	{
-		$self->app->get_journey_stats(
+		$self->app->journeys->get_stats(
 			uid  => $user->{id},
 			year => $now->year
 		);
diff --git a/lib/Travelynx/Controller/Api.pm b/lib/Travelynx/Controller/Api.pm
index 3a2e100..5811c54 100755
--- a/lib/Travelynx/Controller/Api.pm
+++ b/lib/Travelynx/Controller/Api.pm
@@ -1,4 +1,5 @@
 package Travelynx::Controller::Api;
+
 # Copyright (C) 2020 Daniel Friesel
 #
 # SPDX-License-Identifier: MIT
@@ -547,7 +548,7 @@ sub import_v1 {
 		);
 	}
 	else {
-		$self->journeys->invalidate_stats_cache(
+		$self->journey_stats_cache->invalidate(
 			ts  => $opt{rt_departure},
 			db  => $db,
 			uid => $uid
diff --git a/lib/Travelynx/Controller/Traveling.pm b/lib/Travelynx/Controller/Traveling.pm
index a1c9a7d..842af32 100755
--- a/lib/Travelynx/Controller/Traveling.pm
+++ b/lib/Travelynx/Controller/Traveling.pm
@@ -1,4 +1,5 @@
 package Travelynx::Controller::Traveling;
+
 # Copyright (C) 2020 Daniel Friesel
 #
 # SPDX-License-Identifier: MIT
@@ -917,7 +918,10 @@ sub yearly_history {
 			before        => $interval_end,
 			with_datetime => 1
 		);
-		$stats = $self->get_journey_stats( year => $year );
+		$stats = $self->journeys->get_stats(
+			uid  => $self->current_user->{id},
+			year => $year
+		);
 	}
 
 	$self->respond_to(
@@ -979,7 +983,8 @@ sub monthly_history {
 			before        => $interval_end,
 			with_datetime => 1
 		);
-		$stats = $self->get_journey_stats(
+		$stats = $self->journeys->get_stats(
+			uid   => $self->current_user->{id},
 			year  => $year,
 			month => $month
 		);
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;