Merge pull request #33 from Pear-Trading/TBSliver/Recalc-Leaderboards

Recalculate Leaderboards

cpanfile

@@ -20,3 +20,4 @@ requires 'Try::Tiny';
 requires 'MooX::Options::Actions';
 requires 'Module::Runtime';
 requires 'DBIx::Class::DeploymentHandler';
+requires 'DBIx::Class::Fixtures';

doc/Fixtures/Leaderboards.md

@@ -0,0 +1,32 @@
+# Leaderboard Fixtures
+
+* Fixture Name: `leaderboards`
+
+## Users:
+
+* Test User1
+  * email: test1@example.com
+  * password: abc123
+* Test User2
+  * email: test2@example.com
+  * password: abc123
+* Test User3
+  * email: test3@example.com
+  * password: abc123
+* Test User4
+  * email: test4@example.com
+  * password: abc123
+* Test Org
+  * email: test5@example.com
+  * password: abc123
+
+## Transactions
+
+Uses the same transactions as the `Transactions` fixtures set.
+
+## Leaderboards
+
+Pre calculated leaderboards for all normal leaderboard types.
+
+* Daily Total/Count
+  * Daily from May 3rd 2017 until July 31st 2017

doc/Fixtures/Transactions.md

@@ -0,0 +1,26 @@
+# Leaderboard Fixtures
+
+* Fixture Name: `transactions`
+
+## Users:
+
+* Test User1
+  * email: test1@example.com
+  * password: abc123
+* Test User2
+  * email: test2@example.com
+  * password: abc123
+* Test User3
+  * email: test3@example.com
+  * password: abc123
+* Test User4
+  * email: test4@example.com
+  * password: abc123
+* Test Org
+  * email: test5@example.com
+  * password: abc123
+
+## Transactions:
+
+One transaction every 10 minutes, starting at August 1st 2017 and going back in
+time, for each user. All transactions go to Test Org.

doc/Leaderboards.md

@@ -0,0 +1,16 @@
+# Leaderboards
+
+## Calculation
+
+The leaderboards are calculated for the previous range - so Daily leaderboards
+are calculated for the whole of the day before, Weeks from the week before,
+etc. - The only exception is all time, which is calculated from 00:00 on the
+current day.
+
+## Recalculation
+
+Leaderboard recalculation only affects the latest two leaderboards for any set,
+so just need to recalculate the last one and the current one, in that order.
+This can be done during the regular leaderboard calculation cronjob, so
+verified transactions will show up in the leaderboards the next day.
+

lib/Pear/LocalLoop/Command/recalc_leaderboards.pm

@@ -0,0 +1,26 @@
+package Pear::LocalLoop::Command::recalc_leaderboards;
+use Mojo::Base 'Mojolicious::Command';
+
+use Mojo::Util 'getopt';
+
+has description => 'Build All leaderboards';
+
+has usage => sub { shift->extract_usage };
+
+sub run {
+  my ( $self, @args ) = @_;
+
+  my $leaderboard_rs = $self->app->schema->resultset('Leaderboard');
+
+  $leaderboard_rs->recalculate_all;
+}
+
+=head1 SYNOPSIS
+
+  Usage: APPLICATION recalc_leaderboards
+
+  Recalculates ALL leaderboards.
+
+=cut
+
+1;

lib/Pear/LocalLoop/Schema/Result/Leaderboard.pm

@@ -184,7 +184,7 @@ sub _create_total_all_time {
   my @leaderboard;
 
   while ( my $user_result = $user_rs->next ) {
-    my $transaction_rs = $user_result->transactions;
+    my $transaction_rs = $user_result->transactions->search_before( $end );
 
     my $transaction_sum = $transaction_rs->get_column('value')->sum;
 
@@ -215,7 +215,7 @@ sub _create_count_all_time {
   my @leaderboard;
 
   while ( my $user_result = $user_rs->next ) {
-    my $transaction_rs = $user_result->transactions;
+    my $transaction_rs = $user_result->transactions->search_before( $end );
 
     my $transaction_count = $transaction_rs->count;
 

lib/Pear/LocalLoop/Schema/ResultSet/Leaderboard.pm

@@ -5,6 +5,8 @@ use warnings;
 
 use base 'DBIx::Class::ResultSet';
 
+use DateTime;
+
 sub get_latest {
   my $self = shift;
   my $type = shift;
@@ -39,4 +41,54 @@ sub find_by_type {
   return $self->find({ type => $type });
 }
 
+sub recalculate_all {
+  my $self = shift;
+
+  for my $leaderboard_result ( $self->all ) {
+    my $lb_type = $leaderboard_result->type;
+    if ( $lb_type =~ /^daily/ ) {
+
+      # Recalculating a daily set. This is calculated from the start of the
+      # day, so we need yesterdays date:
+      my $date = DateTime->today->subtract( days => 1 );
+      $self->_recalculate_leaderboard( $leaderboard_result, $date, 'days' );
+
+    } elsif ( $lb_type =~ /^weekly/ ) {
+
+      # Recalculating a weekly set. This is calculated from a Monday, of the
+      # week before.
+      my $date = DateTime->today->truncate( to => 'week' )->subtract( weeks => 1 );
+      $self->_recalculate_leaderboard( $leaderboard_result, $date, 'weeks' );
+
+    } elsif ( $lb_type =~ /^monthly/ ) {
+
+      # Recalculate a monthly set. This is calculated from the first of the
+      # month, for the month before.
+      my $date = DateTime->today->truncate( to => 'month' )->subtract( months => 1);
+      $self->_recalculate_leaderboard( $leaderboard_result, $date, 'months' );
+
+    } elsif ( $lb_type =~ /^all_time/ ) {
+
+      # Recalculate for an all time set. This is calculated similarly to
+      # daily, but is calculated from an end time.
+      my $date = DateTime->today;
+      $self->_recalculate_leaderboard( $leaderboard_result, $date, 'days' );
+
+    } else {
+      warn "Unrecognised Set";
+    }
+  }
+}
+
+sub _recalculate_leaderboard {
+  my ( $self, $lb_result, $date, $diff ) = @_;
+
+  $self->result_source->schema->txn_do( sub {
+    $lb_result->sets->related_resultset('values')->delete_all;
+    $lb_result->sets->delete_all;
+    $lb_result->create_new($date->clone->subtract( $diff => 1 ));
+    $lb_result->create_new($date);
+  });
+}
+
 1;

lib/Pear/LocalLoop/Schema/ResultSet/Transaction.pm

@@ -21,6 +21,15 @@ sub search_between {
   });
 }
 
+sub search_before {
+  my ( $self, $date ) = @_;
+
+  my $dtf = $self->result_source->schema->storage->datetime_parser;
+  return $self->search({
+    purchase_time => { '<' => $dtf->format_datetime( $date ) },
+  });
+}
+
 sub today_rs {
   my ( $self ) = @_;
 

script/daily_leaderboards

@@ -1,11 +0,0 @@
-#! /bin/bash
-
-eval $(perl -I ~/perl5/lib/perl5/ -Mlocal::lib)
-
-YESTERDAY=`date -d "yesterday" +%F`
-
-
-MOJO_MODE=production ./script/pear-local_loop leaderboard -t daily_total -d $YESTERDAY
-MOJO_MODE=production ./script/pear-local_loop leaderboard -t daily_count -d $YESTERDAY
-MOJO_MODE=production ./script/pear-local_loop leaderboard -t all_time_total -d $YESTERDAY
-MOJO_MODE=production ./script/pear-local_loop leaderboard -t all_time_count -d $YESTERDAY

script/monthly_leaderboards

@@ -1,9 +0,0 @@
-#! /bin/bash
-
-eval $(perl -I ~/perl5/lib/perl5/ -Mlocal::lib)
-
-YESTERDAY=`date -d "1 month ago" +%F`
-
-
-MOJO_MODE=production ./script/pear-local_loop leaderboard -t monthly_total -d $YESTERDAY
-MOJO_MODE=production ./script/pear-local_loop leaderboard -t monthly_count -d $YESTERDAY

script/recalc_leaderboards

@@ -0,0 +1,5 @@
+#! /bin/bash
+
+eval $(perl -I ~/perl5/lib/perl5/ -Mlocal::lib)
+
+MOJO_MODE=production ./script/pear-local_loop recalc_leaderboards

script/weekly_leaderboards

@@ -1,9 +0,0 @@
-#! /bin/bash
-
-eval $(perl -I ~/perl5/lib/perl5/ -Mlocal::lib)
-
-YESTERDAY=`date -d "1 week ago" +%F`
-
-
-MOJO_MODE=production ./script/pear-local_loop leaderboard -t weekly_total -d $YESTERDAY
-MOJO_MODE=production ./script/pear-local_loop leaderboard -t weekly_count -d $YESTERDAY

t/etc/fixtures/config/leaderboards.pl

@@ -0,0 +1,109 @@
+#! /usr/bin/env perl
+
+use strict;
+use warnings;
+
+use 5.020;
+
+use DBIx::Class::Fixtures;
+use FindBin qw/ $Bin /;
+use lib "$Bin/../../../../lib";
+use Pear::LocalLoop::Schema;
+use DateTime;
+use Devel::Dwarn;
+
+my $fixtures = DBIx::Class::Fixtures->new({
+  config_dir => "$Bin",
+});
+
+my $schema = Pear::LocalLoop::Schema->connect('dbi:SQLite::memory:');
+
+$schema->deploy;
+
+$fixtures->populate({
+  directory => "$Bin/../data/transactions",
+  no_deploy => 1,
+  schema => $schema,
+});
+
+my $trans_rs = $schema->resultset('Transaction')->search( undef, { order_by => { '-asc' => 'purchase_time' } } );
+
+my $first = $trans_rs->first->purchase_time;
+
+# Start with the first monday after this transaction
+my $beginning_of_week = $first->clone->truncate( to => 'week' );
+
+# Start with the first month after this transaction
+my $beginning_of_month = $first->clone->truncate( to => 'month' );
+
+say "First Entry";
+say $first->iso8601;
+say "First Week";
+say $beginning_of_week->iso8601;
+say "First Month";
+say $beginning_of_month->iso8601;
+
+$trans_rs = $schema->resultset('Transaction')->search( undef, { order_by => { '-desc' => 'purchase_time' } } );
+
+my $last = $trans_rs->first->purchase_time->subtract( days => 1 );
+
+my $end_week = $last->clone->truncate( to => 'week' )->subtract( weeks => 1 );
+
+my $end_month = $last->clone->truncate( to => 'month' );
+
+say "Last Entry";
+say $last->iso8601;
+say "Last Week";
+say $end_week->iso8601;
+say "Last Month";
+say $end_month->iso8601;
+
+say "Calculating Daily Leaderboards from " . $first->iso8601 . " to " . $last->iso8601;
+
+my $leaderboard_rs = $schema->resultset('Leaderboard');
+my $daily_date = $first->clone;
+
+while ( $daily_date <= $last ) {
+  say "Creating Daily Total for " . $daily_date->iso8601;
+  $leaderboard_rs->create_new( 'daily_total', $daily_date );
+  say "Creating Daily Count for " . $daily_date->iso8601;
+  $leaderboard_rs->create_new( 'daily_count', $daily_date );
+  $daily_date->add( days => 1 );
+}
+
+say "Created " . $leaderboard_rs->find({ type => 'daily_total' })->sets->count . " Daily Total boards";
+say "Created " . $leaderboard_rs->find({ type => 'daily_count' })->sets->count . " Daily Count boards";
+
+my $weekly_date = $beginning_of_week->clone;
+
+while ( $weekly_date <= $end_week ) {
+  say "Creating Weekly Total for " . $weekly_date->iso8601;
+  $leaderboard_rs->create_new( 'weekly_total', $weekly_date );
+  say "Creating Weekly Count for " . $weekly_date->iso8601;
+  $leaderboard_rs->create_new( 'weekly_count', $weekly_date );
+  $weekly_date->add( weeks => 1 );
+}
+
+say "Created " . $leaderboard_rs->find({ type => 'weekly_total' })->sets->count . " Weekly Total boards";
+say "Created " . $leaderboard_rs->find({ type => 'weekly_count' })->sets->count . " Weekly Count boards";
+
+my $monthly_date = $beginning_of_month->clone;
+
+while ( $monthly_date <= $end_month ) {
+  say "Creating Monthly Total for " . $monthly_date->iso8601;
+  $leaderboard_rs->create_new( 'monthly_total', $monthly_date );
+  say "Creating Monthly Count for " . $monthly_date->iso8601;
+  $leaderboard_rs->create_new( 'monthly_count', $monthly_date );
+  $monthly_date->add( months => 1 );
+}
+
+say "Created " . $leaderboard_rs->find({ type => 'monthly_total' })->sets->count . " Monthly Total boards";
+say "Created " . $leaderboard_rs->find({ type => 'monthly_count' })->sets->count . " Monthly Count boards";
+
+my $data_set = 'leaderboards';
+
+$fixtures->dump({
+  all => 1,
+  schema => $schema,
+  directory => "$Bin/../data/" . $data_set,
+});

t/etc/fixtures/config/transactions.pl

@@ -0,0 +1,128 @@
+#! /usr/bin/env perl
+
+use strict;
+use warnings;
+
+use DBIx::Class::Fixtures;
+use FindBin qw/ $Bin /;
+use lib "$Bin/../../../../lib";
+use Pear::LocalLoop::Schema;
+use DateTime;
+use Devel::Dwarn;
+
+my $fixtures = DBIx::Class::Fixtures->new({
+  config_dir => "$Bin",
+});
+
+my $schema = Pear::LocalLoop::Schema->connect('dbi:SQLite::memory:');
+
+$schema->deploy;
+
+$schema->resultset('Leaderboard')->populate([
+  [ qw/ name type / ],
+  [ 'Daily Total', 'daily_total' ],
+  [ 'Daily Count', 'daily_count' ],
+  [ 'Weekly Total', 'weekly_total' ],
+  [ 'Weekly Count', 'weekly_count' ],
+  [ 'Monthly Total', 'monthly_total' ],
+  [ 'Monthly Count', 'monthly_count' ],
+  [ 'All Time Total', 'all_time_total' ],
+  [ 'All Time Count', 'all_time_count' ],
+]);
+
+my $user1 = {
+  customer => {
+    full_name    => 'Test User1',
+    display_name => 'Test User1',
+    postcode     => 'LA1 1AA',
+    year_of_birth => 2006,
+  },
+  email        => 'test1@example.com',
+  password     => 'abc123',
+};
+
+my $user2 = {
+  customer => {
+    full_name    => 'Test User2',
+    display_name => 'Test User2',
+    postcode     => 'LA1 1AA',
+    year_of_birth => 2006,
+  },
+  email        => 'test2@example.com',
+  password     => 'abc123',
+};
+
+my $user3 = {
+  customer => {
+    full_name    => 'Test User3',
+    display_name => 'Test User3',
+    postcode     => 'LA1 1AA',
+    year_of_birth => 2006,
+  },
+  email        => 'test3@example.com',
+  password     => 'abc123',
+};
+
+my $user4 = {
+  customer => {
+    full_name    => 'Test User4',
+    display_name => 'Test User4',
+    postcode     => 'LA1 1AA',
+    year_of_birth => 2006,
+  },
+  email        => 'test4@example.com',
+  password     => 'abc123',
+};
+
+my $org = {
+  organisation => {
+    name        => 'Test Org',
+    street_name => 'Test Street',
+    town        => 'Lancaster',
+    postcode    => 'LA1 1AA',
+  },
+  email       => 'test5@example.com',
+  password    => 'abc123',
+};
+
+$schema->resultset('User')->create( $_ )
+  for ( $user1, $user2, $user3, $user4, $org );
+
+my $org_result = $schema->resultset('Organisation')->find({ name => $org->{organisation}{name} });
+
+my $dtf = $schema->storage->datetime_parser;
+
+# Number of hours in 90 days
+my $time_count = 24 * 90;
+
+for my $user ( $user1, $user2, $user3, $user4 ) {
+
+  my $start = DateTime->new(
+    year => 2017,
+    month => 8,
+    day => 1,
+    hour => 0,
+    minute => 0,
+    second => 0,
+    time_zone => 'UTC',
+  );
+
+  my $user_result = $schema->resultset('User')->find({ email => $user->{email} });
+  for ( 0 .. $time_count ) {
+    $user_result->create_related( 'transactions', {
+      seller_id => $org_result->id,
+      value => ( int( rand( 10000 ) ) / 100 ),
+      proof_image => 'a',
+      purchase_time => $start->clone->subtract( hours => $_ ),
+    });
+  }
+}
+
+my $data_set = 'transactions';
+
+$fixtures->dump({
+  all => 1,
+  schema => $schema,
+  directory => "$Bin/../data/" . $data_set,
+});
+

t/schema/leaderboard.t

@@ -215,10 +215,10 @@ test_leaderboard(
   'all_time_total',
   $now,
   [
-    { user_id => 4, value => 980 },
+    { user_id => 4, value => 885 },
-    { user_id => 3, value => 940 },
+    { user_id => 3, value => 855 },
-    { user_id => 2, value => 900 },
+    { user_id => 2, value => 825 },
-    { user_id => 1, value => 860 },
+    { user_id => 1, value => 795 },
   ]
 );
 
@@ -227,10 +227,10 @@ test_leaderboard(
   'all_time_count',
   $now,
   [
-    { user_id => 1, value => 40 },
+    { user_id => 1, value => 30 },
-    { user_id => 2, value => 40 },
+    { user_id => 2, value => 30 },
-    { user_id => 3, value => 40 },
+    { user_id => 3, value => 30 },
-    { user_id => 4, value => 40 },
+    { user_id => 4, value => 30 },
   ]
 );
 

t/schema/resultset_leaderboard.t

@@ -217,10 +217,10 @@ test_leaderboard(
   'all_time_total',
   $now,
   [
-    { user_id => 4, value => 980, position => 1 },
+    { user_id => 4, value => 885, position => 1 },
-    { user_id => 3, value => 940, position => 2 },
+    { user_id => 3, value => 855, position => 2 },
-    { user_id => 2, value => 900, position => 3 },
+    { user_id => 2, value => 825, position => 3 },
-    { user_id => 1, value => 860, position => 4 },
+    { user_id => 1, value => 795, position => 4 },
   ]
 );
 
@@ -229,10 +229,10 @@ test_leaderboard(
   'all_time_count',
   $now,
   [
-    { user_id => 1, value => 40, position => 1 },
+    { user_id => 1, value => 30, position => 1 },
-    { user_id => 2, value => 40, position => 2 },
+    { user_id => 2, value => 30, position => 2 },
-    { user_id => 3, value => 40, position => 3 },
+    { user_id => 3, value => 30, position => 3 },
-    { user_id => 4, value => 40, position => 4 },
+    { user_id => 4, value => 30, position => 4 },
   ]
 );