frenfstats

#!/usr/bin/perl
# vim: shiftwidth=4 tabstop=4
#
# Copyright by Marco d'Itri <md@linux.it>.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.

use v5.36;
use experimental qw(for_list);
use utf8;
use open qw(:locale);

use Path::Tiny;
use HTTP::Tiny;
use JSON::XS;
use List::Util qw(max);

my $Soglia_Giocate = 80; # percentuale

my %Year_To_Entry = (
	2023 => 1094792,
	2024 => 1098704,
);

##############################################################################
{
	my $source = $ARGV[0];

	my $page_text;
	if (not $source) {
		die "Usage: $0 [ANNO|URL|NUMERO_POST|FILE_JSON]\n";
	} elsif (-e $source) {
		$page_text = path($source)->slurp_raw;
	} elsif ($source =~ /^\d{4}$/) {
		die "Anno '$source' sconosciuto!\n"
			if not exists $Year_To_Entry{$source};
		$source = "https://www.frenf.it/earlyadopters/api/1.1/entry/"
			. $Year_To_Entry{$source};
	} elsif ($source =~ /^\d{7,8}$/) {
		$source = "https://www.frenf.it/earlyadopters/api/1.1/entry/$source";
	} elsif ($source =~ m#/earlyadopters/p/\S+/(\d+)$#) {
		$source = "https://www.frenf.it/earlyadopters/api/1.1/entry/$1";
	} else {
		die "URL '$source' non riconosciuto!\n";
	}

	$page_text ||= get_page_with_cache($source);

	my $comments = get_comments($page_text);
	my $results = get_results($comments);
	stats($results);

	exit;
}

##############################################################################
sub stats ($results) {
	my @scores;

	# per ogni partita di ciascun utente:
	foreach my ($user, $words) (@$results) {
		my $giuste    = grep {     /^(.)(?:\1){3}$/ } @$words;
		my $sbagliate = grep { not /^(.)(?:\1){3}$/ } @$words;
		my $punti = 0;					# si parte da zero punti
		if ($giuste == 4) {				# solo se la partita è stata vinta
			$punti = 5 - $sbagliate;	# si assegnano 5 punti, meno gli errori
		}
		push(@scores, $user, $punti);
	}

	# per ogni risultato somma i punti per l'utente e conta il numero di
	# partite che ha giocato
	my %punti;
	my %giocate;
	foreach my ($user, $score) (@scores) {
		$punti{$user} += $score;
		$giocate{$user}++;
	}

	my $numero_partite = max(values %giocate);
	my $soglia = int($numero_partite / 100 * $Soglia_Giocate);

	# calcola il punteggio medio per partita, ma escludendo chi non ne ha
	# giocato almeno l'80% (valore di $soglia)
	my %media =
		map { $_ => $punti{$_} / $giocate{$_} }
		grep { $giocate{$_} >= $soglia }
		keys %punti;

	say 'Punti: ' . join(', ',
		map { "$_: $punti{$_}" }
		reverse sort { $punti{$a} <=> $punti{$b} }
		keys %punti
	) . '.';
	say 'Giocate: ' . join(', ',
		map { "$_: $giocate{$_}" }
		reverse sort { $giocate{$a} <=> $giocate{$b} }
		keys %giocate
	) . '.';
	say "Media punti per partita (per chi ha giocato almeno"
			. " $soglia volte su $numero_partite): " . join(', ',
		map { sprintf("%s: %.2f", $_, $media{$_}) }
		reverse sort { $media{$a} <=> $media{$b} }
		keys %media
	) . '.';

	return;
}

##############################################################################
sub get_results ($comments) {
	my @results;

	foreach my ($user, $text) (@$comments) {
		# cerca i risultati nel commento
		my @v = $text =~ /
			(?<= \s|^)
			([🟨🟦🟩🟪]{4})
			(?= \s|$)
		/gx;

		if (not @v) {	# se non ne ha trovati
			# ignora le righe dove non c'è nulla che sembri un risultato
			next if not $text =~ /[🟨🟦🟩🟪]/;
			# altrimenti termina
			die "Non riesco a decifrare '$text'";
		}

		push(@results, $user, \@v);
	}

	return \@results;
}

sub get_comments ($text) {
	my $json = decode_json($text);
	die if not $json->{entry}->{comments};

	# estrae tutti i commenti dal JSON della pagina restituito dal sito
	my @comments;
	foreach (@{ $json->{entry}->{comments} }) {
		my $user = $_->{sender}->{username} or die;
		push(@comments, $user, $_->{text});
	}

	return \@comments;
}

sub get_page_with_cache ($url, $ttl ||= 8 * 60 * 60) {
	my $cache_file;

	if ($url =~ m#/(\d+)$#) {
		$cache_file = path("$1.js");
	} else {
		die;
	}

	# restituisce la copia in cache, se esiste ed è fresca
	if ($cache_file and $cache_file->exists) {
		my $age = time - $cache_file->stat->mtime;
		return $cache_file->slurp_raw if $age < $ttl;
	}

	my $response = HTTP::Tiny->new->get($url);
	die "FAILED: $response->{status} $response->{reason} for $url"
		if not $response->{success};

	# salva la cache
	$cache_file->spew_raw($response->{content}) if $cache_file;

	return $response->{content};
}