#!/usr/bin/perl
# =============================================================================
# Verificateur du schema complet — EcoVivo, espace client
#
#   perl outils/verifier-schema.pl            depuis site/
#   perl outils/verifier-schema.pl chemin.sql pour un autre fichier
#
# Pourquoi cet outil existe
# -------------------------
# 000-schema-complet.sql est le point d entree d une base neuve : il purge tout,
# puis recree tout. Trois fautes y sont invisibles a l ecriture et ne se
# manifestent qu au reimport suivant, en pleine purge, la moitie des tables
# etant deja tombee :
#
#   1. une table ajoutee au schema mais oubliee dans la liste de purge ;
#   2. une table purgee AVANT sa parente alors qu une autre la reference
#      encore — c est le #3730 « Cannot drop table referenced by a foreign
#      key constraint » ;
#   3. une table qui reference une parente pas encore creee.
#
# Aucune ne se voit a la relecture : il faut comparer deux listes de trente
# lignes et un graphe de dependances. C est exactement ce qu une machine fait
# mieux qu un oeil, et ce poste n a pas de client MySQL pour l essayer a blanc.
#
# Les tables d anciennes versions du schema (purgees sans etre recreees, comme
# phase et phase_evenement) sont normales et ne sont pas signalees.
# =============================================================================
use strict;
use warnings;

my $fichier = shift @ARGV // 'migrations/000-schema-complet.sql';

open(my $h, '<', $fichier) or die "Fichier introuvable : $fichier\n";
my $sql = do { local $/; <$h> };
close $h;

# --- Les tables creees, dans l ordre du fichier ------------------------------
my @creees = $sql =~ /^CREATE TABLE (?:IF NOT EXISTS )?(\w+)/gm;

# --- Les tables purgees, dans l ordre de la liste ----------------------------
my ($bloc) = $sql =~ /DROP TABLE IF EXISTS(.*?);/s;
unless (defined $bloc) {
    print "Aucun bloc DROP TABLE : rien a verifier.\n";
    exit 0;
}
my @purgees = $bloc =~ /(\w+)/g;

my %purgee = map { $_ => 1 } @purgees;
my %rang;
$rang{ $purgees[$_] } = $_ for 0 .. $#purgees;

my @erreurs;

# --- 1. Toute table creee doit figurer dans la purge -------------------------
for my $t (@creees) {
    push @erreurs, "table « $t » creee mais ABSENTE de la liste de purge"
        unless $purgee{$t};
}

# --- 2 et 3. Le graphe des cles etrangeres -----------------------------------
# On relit table par table pour rattacher chaque REFERENCES a son enfant.
my %deja_creee;
while ($sql =~ /^CREATE TABLE (?:IF NOT EXISTS )?(\w+)(.*?)^\) ENGINE/gms) {
    my ($enfant, $corps) = ($1, $2);
    $deja_creee{$enfant} = 1;

    while ($corps =~ /REFERENCES\s+(\w+)\s*\(/g) {
        my $parente = $1;

        # Une cle etrangere vers soi-meme ne contraint aucun ordre.
        next if $parente eq $enfant;

        push @erreurs,
            "« $enfant » reference « $parente », creee plus loin dans le fichier"
            unless $deja_creee{$parente};

        next unless exists $rang{$enfant} && exists $rang{$parente};
        push @erreurs,
            "« $enfant » est purgee APRES sa parente « $parente » (#3730 au reimport)"
            if $rang{$enfant} > $rang{$parente};
    }
}

# --- Verdict -----------------------------------------------------------------
my %vu;
@erreurs = grep { !$vu{$_}++ } @erreurs;

printf "%s : %d table(s) creee(s), %d purgee(s).\n",
    $fichier, scalar(@creees), scalar(@purgees);

if (@erreurs) {
    print "  - $_\n" for @erreurs;
    printf "%d probleme(s).\n", scalar(@erreurs);
    exit 1;
}

print "OK : liste de purge complete, enfants avant parentes, parentes avant enfants.\n";
exit 0;