#!/usr/bin/env perl
# vim:noexpandtab:ts=8:sw=4
#
# Copyright (c) 2013-2014 Yon <anaseto@bardinflor.perso.aquilenet.fr>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

use strict;
use warnings;
use autodie;
use Term::ANSIColor;        # couleurs
use Getopt::Long;

=encoding utf-8

=head1 Usage

perl agreg.pl <command> [options]

=head1 Description

Il s'agit d'un petit programme qui à partir d'infos écrites dans plusieurs
fichiers concernant les leçons et les développements fournit diverses
statistiques pour monitorer l'avancement du travail.

Voir la section L<Exemples> pour des exemples d'utilisation, et la section
L<Fichiers> pour connaître le format des fichiers texte utilisés comme base de
donnée (en résumé, il faut dire au programme quelles sont les leçons, les
développements et les leçons qui vont avec chacun, et les leçons déjà faites en
cours).

=head1 Exemples

Les commandes suivantes sont à lancer dans le dossier contenant les fichiers
listés à la section L<Fichiers>.

    $ perl agreg.pl         # Stats diverses sur les leçons/développements
                            # (les couleurs discriminent les leçons déjà vues
                            # en cours des autres).
    $ perl agreg.pl stats   # Idem.

    $ perl agreg.pl titres  # Liste des titres des leçons (en couleurs).


    $ perl agreg.pl devs    # Nombre de leçons par développement.

    $ perl agreg.pl devs -l
                            # Liste des couplages développement-leçons (avec
                            # couleurs suivant si la leçon a été déjà faite en
                            # cours ou non).
    $ perl agreg.pl devs -l -math
    $ perl agreg.pl devs -l -m
                            # Idem mais que les devs de maths.
    $ perl agreg.pl devs -l -info
    $ perl agreg.pl devs -l -i
                            # Idem mais que les devs d'info.

    $ perl agreg.pl devs -r
                            # Liste des développements redondants (au sens si
                            # on en enlève un alors les leçons pour lesquelles
                            # il est censé servir ont encore au moins deux
                            # développements).

    $ perl agreg.pl desc 104
                            # Descriptions détaillées sur la leçon 104
                            # numéro, titre, et liste des développements possibles.
                            # On peut mettre plusieurs numéros à la suite.

    $ perl agreg.pl lecons  # Nombre de développements par leçon

    $ perl agreg.pl lecons -no-zeros 
    $ perl agreg.pl lecons -z
                            # Idem mais sans les leçons avec zéro développements.

    $ perl agreg.pl lecons -incomplete
                            # Idem mais sans les leçons avec plus de deux développements.

    $ perl agreg.pl --help  # Aide.
   
=head1 Fichiers

Tous ces fichiers doivent être dans le même dossier depuis lequel on lance le
programme.

=over

=item C<num-titre.txt>

Fichier contenant les numéros suivi du titre de chaque leçon (un
par ligne, au moins un espace entre le numéro et le titre)

    numéro titre
    ...

=item C<liste-devs-nums.txt>

Fichier qui contient la liste des développements et les leçons
correspondant à chacun.

    titre du développement
    numéros de leçons séparés par des virgules

    autre titre
    ...

Les lignes commençant par # sont traitées comme des lignes blanches
(c'est pour pouvoir écrire des commentaires)

=item C<lecons-faites.txt>

Fichier avec les lecons déjà faites en cours : une seule ligne avec des numéros
séparés par des virgules.

=item C<devs.tex>

Fichier optionnel où chaque sous-section est un développement.

=back

=head1 Configuration

L'option C<--no-bright> passe en mode 8 couleurs (utile seulement pour les
terminaux qui ne supporteraient que 8 couleurs)

=cut

my %fichiers = (
	num_titre       => 'num-titre.txt',
	tex             => 'devs.tex',
	liste_devs_nums => 'liste-devs-nums.txt',
	lecons_faites   => 'lecons-faites.txt',
);

my %colors = (
	title           => 'bright_blue',
	lecon_faite     => 'bright_green',        # leçon faite en cours
	lecon_non_faite => 'bright_red',
	total           => 'magenta',
);

my $usage = <<EOF;
Usage:
    perl $0 <command> [options]

Use perldoc to read pod docs with the command:

    perldoc $0
EOF

# options
my $opt_help;
my $opt_no_zero;            # pour action lecons
my $opt_incomplete;         # pour action lecons
my $opt_list;               # pour dev num-list
my $opt_no_bright;          # pour couleurs basiques
my $opt_math;               # pour devs -l --math
my $opt_info;               # pour devs -l --info
my $opt_redondances;        # pour devs -r

GetOptions(
	help        => \$opt_help,
	incomplete  => \$opt_incomplete,
	l           => \$opt_list,
	list        => \$opt_list,
	i           => \$opt_info,
	'info'      => \$opt_info,
	m           => \$opt_math,
	'math'      => \$opt_math,
	'no-bright' => \$opt_no_bright,
	r           => \$opt_redondances,
	'z'         => \$opt_no_zero,
	'no-zeros'  => \$opt_no_zero,
) or die "bad options!\n$usage";

# Si la version de perl est < 5.13
if ($Term::ANSIColor::VERSION < 3.00) {
	$opt_no_bright = 1;
}

if ($opt_no_bright) {
	$colors{$_} =~ s/bright_// for keys %colors;
}

sub main
{
	print $usage and exit if $opt_help;
	my $action = shift @ARGV // "stats";
	my %rules = (
		stats  => \&action_stats,
		titres => \&action_titres,
		tex    => \&action_tex,
		devs   => eval {
			if ($opt_redondances) {
				return \&action_devs_redondances;
			} elsif ($opt_list) {
				return \&action_devslist;
			} else {
				return \&action_devs;
			}
		},
		desc => eval {
			if (@ARGV) {
				return sub { action_desc(@ARGV) }
			} else {
				return sub { print $usage };
			}
		},
		lecons => eval {
			return \&action_lecons;
		},
	);
	if (defined $rules{$action}) {
		$rules{$action}->();
	} else {
		print $usage;
	}
}

main();

################################################################################
# Actions
################################################################################

sub action_stats
{
	# statistiques diverses
	my $devs = parse_liste_devs_nums();

	# nombre de leçons par développement
	my $lecons        = compute_lecons_with_dev($devs);
	my $titres        = parse_num_titres();
	my $lecons_faites = parse_lecons_faites();
	print colored("Leçons: ", $colors{title}), scalar(keys %$titres), "\n";

	my $nbr_3devs;
	print colored("Trois dévs (au moins): ", $colors{title});
	foreach (sort keys %$lecons) {
		if (defined $lecons->{$_} and $lecons->{$_} > 2) {
			print_lecon_num($_, $lecons_faites);
			$nbr_3devs++;
		}
	}
	print "\n";
	print colored('=> total: ', $colors{total}), $nbr_3devs, "\n";

	my $nbr_2devs;
	print colored("Deux dévs (au moins): ", $colors{title});
	foreach (sort keys %$lecons) {
		if (defined $lecons->{$_} and $lecons->{$_} >= 2) {
			print_lecon_num($_, $lecons_faites);
			$nbr_2devs++;
		}
	}
	print "\n";
	print colored('=> total: ', $colors{total}), $nbr_2devs, "\n";

	my $nbr_1devs;
	print colored('Un dév: ', $colors{title});
	foreach (sort keys %$lecons) {
		if (defined $lecons->{$_} and $lecons->{$_} == 1) {
			print_lecon_num($_, $lecons_faites);
			$nbr_1devs++;
		}
	}
	print "\n";
	print colored('=> total: ', $colors{total}), $nbr_1devs, "\n";

	my $nbr_sans = 0;
	print colored('Zéro dévs (encore): ', $colors{title});
	foreach my $titre (sort keys %$titres) {
		print_lecon_num($titre, $lecons_faites) and $nbr_sans++
		    unless defined $lecons->{$titre};
	}
	print "\n";
	print colored('=> total: ', $colors{total}), $nbr_sans, "\n";
}

sub action_titres
{
	# liste des titres
	my $titres = parse_num_titres();
	foreach (sort keys %$titres) {
		print colored($_, $colors{title}), " ", $titres->{$_}, "\n";
	}
}

sub action_devs
{
	my $devs = parse_liste_devs_nums();
	foreach (sort keys %$devs) {
		my @nums;
		if (ref $devs->{$_} eq 'ARRAY') {
			@nums = @{ $devs->{$_} };
		}
		print "$_ : ";
		print colored(scalar(@nums), $colors{title}), "\n";
	}
}

sub action_devslist
{
	my $devs          = parse_liste_devs_nums();
	my $lecons_faites = parse_lecons_faites();
	foreach (sort keys %$devs) {
		my @nums;
		if (ref $devs->{$_} eq 'ARRAY') {
			@nums = @{ $devs->{$_} };
		}
		next if $opt_math and "@nums" =~ /9\d\d/;
		next if $opt_info and "@nums" =~ /[12]\d\d/;
		print "$_ : ";
		print_lecon_num($_, $lecons_faites) foreach @nums;
		print "\n";
	}
}

sub action_devs_redondances
{
	my $devs   = parse_liste_devs_nums();
	my $lecons = compute_lecons_with_dev($devs);

	print colored("Développements redondants:\n", $colors{title});

	foreach my $dev (sort keys %$devs) {
		my $redondances = 0;
		my @nums;
		if (ref $devs->{$dev} eq 'ARRAY') {
			@nums = @{ $devs->{$dev} };
		}
		foreach (@nums) {
			$redondances++ if $lecons->{$_} > 2;
		}
		if ($redondances == @nums) {
			print colored("  - ", $colors{title}), "$dev\n";
		}
	}
}

sub action_desc
{
	my @lecons = @_;
	my $devs   = parse_liste_devs_nums();
	my $titres = parse_num_titres();
	foreach my $lecon (@lecons) {
		warn "Invalid leçon number '$lecon'\n" and next
		    unless $lecon =~ /^\d+$/ and defined $titres->{$lecon};
		print colored("Leçon: ", $colors{title}), "$lecon\n";
		print colored("Titre: ", $colors{title}), "$titres->{$lecon}\n";
		print colored("Développements possibles:\n", $colors{title});
		foreach my $dev (keys %$devs) {
			my @nums;
			if (ref $devs->{$dev} eq 'ARRAY') {
				@nums = @{ $devs->{$dev} };
			}
			foreach (@nums) {
				print colored("  - ", $colors{title}), "$dev\n"
				    and last
				    if $_ == $lecon;
			}
		}
	}
}

sub action_lecons
{
	my $devs   = parse_liste_devs_nums();
	my $titres = parse_num_titres();
	my $lecons = compute_lecons_with_dev($devs);
	unless ($opt_no_zero) {
		foreach (keys %$titres) {
			$lecons->{$_} = 0 unless exists $lecons->{$_};
		}
	}
	if ($opt_incomplete) {
		foreach (keys %$lecons) {
			delete $lecons->{$_} if $lecons->{$_} >= 2;
		}
	}
	foreach (sort keys %$lecons) {
		print colored($_, $colors{title}), ": $lecons->{$_}\n";
	}
}

################################################################################
# Parse
################################################################################

sub parse_num_titres
{
	open(my $fh, '<', $fichiers{num_titre});
	my %num_titres;
	while (my $line = <$fh>) {
		chomp $line;
		my ($num, $titre) = split /\s+/, $line, 2;
		warn "not a number at line $. of '$fichiers{num_titre}'\n"
		    unless $num =~ /^\d+$/;
		$num_titres{$num} = $titre;
	}
	close $fh;
	return \%num_titres;
}

sub parse_devs
{
	my $text;
	{
		open(my $fh, '<', $fichiers{tex});
		local $/;
		$text = <$fh>;
		close $fh;
	}
	my @devs;
	while ($text =~ m/\\subsection{([^}]*)}/sg) {
		my $titre = $1;
		$titre =~ s/\n/ /g;
		push @devs, $titre;
	}
	return \@devs;
}

sub parse_liste_devs_nums
{
	my %devs;
	open(my $fh, '<', $fichiers{liste_devs_nums});
	while (my $line = <$fh>) {
		chomp $line;
		next
		    if $line =~ /^\h*$/         # ligne blanche
		    or $line =~ /^\s*#/;        # commentaire
		warn
		    "possibly bad title at line $. of '$fichiers{liste_devs_nums}'\n"
		    if $line =~ /^\s*\d+(?:,\s*\d+)*\s*$/;
		my $nums;
		while ($nums = <$fh>) {

			# commentaires
			next if $nums =~ /^\s*#/;
			last;
		}
		next unless $nums;
		chomp $nums;
		$nums =~ s/\s+//g;
		unless ($nums =~ /^\d+/) {
			$devs{$line} = undef;
			next;
		}
		warn "bad formatted number comma-separated list at line $."
		    . " of file '$fichiers{liste_devs_nums}'\n"
		    unless $nums =~ /^\d+(?:,\d+)*$/;
		my @nums = split /,/, $nums;
		$devs{$line} = \@nums;
	}
	close $fh;
	return \%devs;
}

sub parse_lecons_faites
{
	open(my $fh, '<', $fichiers{lecons_faites});
	my $line = <$fh>;
	$line =~ s/\s+//g;
	warn "Incorrect format at line $. of file '$fichiers{lecons_faites}'."
	    . " First line should be a number comma-separated list\n"
	    unless $line =~ /^\d+(?:,\d+)*$/;
	close $fh;
	my %lecons_faites;
	$lecons_faites{$_} = 1 for split /,/, $line;
	return \%lecons_faites;
}

################################################################################
# Misc
################################################################################

sub compute_lecons_with_dev
{
	my $devs = shift;
	my %lecons;
	foreach my $nums (values %$devs) {
		$lecons{$_}++ foreach (@$nums);
	}
	return \%lecons;
}

sub print_lecon_num
{
	my ($num, $lecons_faites) = @_;
	if (defined $lecons_faites->{$num}) {
		print colored("$num ", $colors{lecon_faite});
	} else {
		print colored("$num ", $colors{lecon_non_faite});
	}
}