Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
executable file 97 lines (74 sloc) 2.51 KB
#!/Users/rjbs/.plenv/versions/20.0/bin/perl
use 5.20.0;
use warnings;
use experimental 'signatures';
use DateTime;
use DateTime::Format::Strptime;
use DBI;
use Getopt::Long::Descriptive;
use JSON ();
use LWP::UserAgent;
use LWP::Simple qw(get);
use Term::ANSIColor;
my $dtfs = DateTime::Format::Strptime->new(
pattern => '%F',
time_zone => 'America/New_York'
);
my $today = DateTime->today(time_zone => 'America/New_York');
my $ua = LWP::UserAgent->new;
my $res = $ua->get(
"https://tdp.me/v1/goals/",
'Content-type' => 'application/json',
'X-Access-Token' => $ENV{TDP_TOKEN},
);
die "GOAL GET FAIL: " . $res->as_string unless $res->is_success;
my $data = JSON->new->decode($res->decoded_content);
my $total;
my @results;
sub triangle ($n) { $n * ($n + 1) / 2 }
for my $goal (grep { $_->{active} } @{ $data->{goals} }) {
my $status_res = $ua->get(
"https://tdp.me/v1/goals/$goal->{id}/streak_data",
'Content-type' => 'application/json',
'X-Access-Token' => $ENV{TDP_TOKEN},
);
warn("GOAL $goal->{goal_id} STATUS FAIL: " . $status_res->as_string), next
unless $res->is_success;
my $status = JSON->new->decode($status_res->decoded_content);
my $name = $goal->{name};
my $quantity = $status->{quantity};
my $mulligans = $status->{mulligans};
my $start = $dtfs->parse_datetime( $status->{started_on} );
my $last = $dtfs->parse_datetime( $status->{last_done} );
my $ends = $dtfs->parse_datetime( $status->{ends_on} );
my $safe = $last > $ends ? $last : $ends;
my $length = $today->delta_days($start)->delta_days;
my $until = $today->delta_days($safe )->delta_days;
$until *= -1 if $safe > $today;
if (0 and $name =~ /smoke/ || $name =~ /soda/) {
warn "$goal->{id}: $name -- (TODAY: $today) / (ENDS: $ends) / (LAST: $last) / (SAFE: $safe) / (UNTIL: $until)\n";
warn $status_res->decoded_content, "\n";
}
my $score;
if ($until <= 1) {
$score = $length - $mulligans + $quantity;
} else {
# -n points for the nth day left undone. -1 for the first, -2 for the
# second (meaning -3 total) and so on -- rjbs, 2014-04-25
my $days = abs($until);
$score = - triangle($days);
}
$total += $score;
push @results, {
name => $name,
score => $score,
until => $until,
danger => $until == 1
};
}
for my $result (sort { $b->{score} <=> $a->{score} } @results) {
print color 'bold red' if $result->{danger};
printf "%35s (%4d): %d\n", $result->{name}, $result->{until}, $result->{score};
print color 'reset';
}
print "TOTAL: $total\n";