Cache journey stats

lib/Travelynx.pm

@@ -8,6 +8,7 @@ use DateTime;
 use DBI;
 use Encode qw(decode encode);
 use Geo::Distance;
+use JSON;
 use List::Util qw(first);
 use List::MoreUtils qw(after_incl before_incl);
 use Travel::Status::DE::IRIS;
@@ -227,6 +228,44 @@ sub startup {
 			);
 		}
 	);
+	$self->attr(
+		get_stats_query => sub {
+			my ($self) = @_;
+
+			return $self->app->dbh->prepare(
+				qq{
+					select data from journey_stats
+					where user_id = ? and year = ? and month = ?
+				}
+			);
+		}
+	);
+	$self->attr(
+		add_stats_query => sub {
+			my ($self) = @_;
+
+			return $self->app->dbh->prepare(
+				qq{
+					insert into journey_stats
+					(user_id, year, month, data)
+					values
+					(?, ?, ?, ?)
+				}
+			);
+		}
+	);
+	$self->attr(
+		drop_stats_query => sub {
+			my ($self) = @_;
+
+			return $self->app->dbh->prepare(
+				qq{
+					delete from journey_stats
+					where user_id = ? and year = ? and month = ?
+				}
+			);
+		}
+	);
 	$self->attr(
 		action_query => sub {
 			my ($self) = @_;
@@ -958,6 +997,73 @@ qq{select * from pending_mails where email = ? and num_tries > 1;}
 		}
 	);
 
+	$self->helper(
+		'get_journey_stats' => sub {
+			my ( $self, %opt ) = @_;
+
+			if ( $opt{cancelled} ) {
+				$self->app->log->warning(
+'get_journey_stats called with illegal option cancelled => 1'
+				);
+				return {};
+			}
+
+			my $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.
+
+			$self->app->get_stats_query->execute( $uid, $year, $month );
+			my $rows = $self->app->get_stats_query->fetchall_arrayref;
+
+			if ( @{$rows} == 1 ) {
+				return JSON->new->decode( $rows->[0][0] );
+			}
+
+			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_user_travels(
+				cancelled => $opt{cancelled} ? 1 : 0,
+				verbose   => 1,
+				after     => $interval_start,
+				before    => $interval_end
+			);
+			my $stats = $self->compute_journey_stats(@journeys);
+
+			$self->app->drop_stats_query->execute( $uid, $year, $month );
+			$self->app->add_stats_query->execute( $uid, $year, $month,
+				JSON->new->encode($stats) );
+
+			return $stats;
+		}
+	);
+
 	$self->helper(
 		'get_user_travels' => sub {
 			my ( $self, %opt ) = @_;

lib/Travelynx/Command/database.pm

@@ -71,7 +71,28 @@ sub initialize_db {
 	);
 }
 
-my @migrations = ();
+my @migrations = (
+
+	# v0 -> v1
+	sub {
+		my ($dbh) = @_;
+		return $dbh->do(
+			qq{
+				alter table user_actions
+					add column edited smallint;
+				drop table if exists monthly_stats;
+				create table journey_stats (
+					user_id integer not null references users (id),
+					year smallint not null,
+					month smallint not null,
+					data jsonb not null,
+					primary key (user_id, year, month)
+				);
+				update schema_version set version = 1;
+			}
+		);
+	},
+);
 
 sub run {
 	my ( $self, $command ) = @_;
@@ -96,18 +117,18 @@ sub run {
 		}
 		for my $i ( $schema_version .. $#migrations ) {
 			printf( "Updating to v%d ...\n", $i + 1 );
-			if ( not $migrations[$i]() ) {
+			if ( not $migrations[$i]($dbh) ) {
 				say "Aborting migration; rollback to v${schema_version}";
 				$dbh->rollback;
 				last;
 			}
 		}
-		if ( get_schema_version($dbh) == $#migrations ) {
+		if ( get_schema_version($dbh) == @migrations ) {
 			$dbh->commit;
 		}
 	}
 	elsif ( $command eq 'has-current-schema' ) {
-		if ( get_schema_version($dbh) == $#migrations ) {
+		if ( get_schema_version($dbh) == @migrations ) {
 			say "yes";
 		}
 		else {

lib/Travelynx/Controller/Traveling.pm

@@ -285,7 +285,9 @@ sub monthly_history {
 		qw(Januar Februar März April Mai Juni Juli August September Oktober November Dezember)
 	  );
 
-	if ( not( $year =~ m{ ^ [0-9]{4} $ }x and $month =~ m{ ^ [0-9]{1,2} $ }x ) )
+	if ( $cancelled
+		or
+		not( $year =~ m{ ^ [0-9]{4} $ }x and $month =~ m{ ^ [0-9]{1,2} $ }x ) )
 	{
 		@journeys = $self->get_user_travels( cancelled => $cancelled );
 	}
@@ -301,12 +303,13 @@ sub monthly_history {
 		);
 		my $interval_end = $interval_start->clone->add( months => 1 );
 		@journeys = $self->get_user_travels(
-			cancelled => $cancelled,
+			after  => $interval_start,
-			verbose   => 1,
+			before => $interval_end
-			after     => $interval_start,
+		);
-			before    => $interval_end
+		$stats = $self->get_journey_stats(
+			year  => $year,
+			month => $month
 		);
-		$stats = $self->compute_journey_stats(@journeys);
 	}
 
 	$self->respond_to(