PrivateCoffee/travelynx
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

move statistics cache to a separate model class

Browse source
This commit is contained in:
Daniel Friesel 2020-11-28 21:03:51 +01:00
parent fe08e98067
commit 77ecd6d034
6 changed files with 296 additions and 234 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

210
lib/Travelynx.pm
View file

@ -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;
@ -329,12 +331,24 @@ 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
@ -969,109 +983,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 ) = @_;
@ -2545,95 +2456,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 ) = @_;

3
lib/Travelynx/Command/work.pm
View file

@ -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
);

3
lib/Travelynx/Controller/Api.pm
View file

@ -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

9
lib/Travelynx/Controller/Traveling.pm
View file

@ -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
);

100
lib/Travelynx/Model/JourneyStatsCache.pm Executable file
View file

@ -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;

205
lib/Travelynx/Model/Journeys.pm
View file

@ -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 {
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 )
{
$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;
}
sub get_stats {
my ( $self, %opt ) = @_;
my $ts = $opt{ts};
my $db = $opt{db} // $self->{pg}->db;
my $uid = $opt{uid};
if ( $opt{cancelled} ) {
$self->{log}
->warn('get_journey_stats called with illegal option cancelled => 1');
return {};
}
$db->delete(
'journey_stats',
{
user_id => $uid,
year => $ts->year,
month => $ts->month,
}
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,
);
$db->delete(
'journey_stats',
{
user_id => $uid,
year => $ts->year,
month => 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;