#!/usr/bin/perl
# dsarregla: el .ds con sus errores corregidos, en ARCHIVO.ds2.
#
#   dsarregla ARCHIVO.ds [-o SALIDA.ds2 | -o -]     por defecto ARCHIVO.ds2
#   dsarregla -n ARCHIVO.ds                          solo dice que corregiria
#
# El .ds2 es el mismo .ds, en el mismo lenguaje, con lo que hacia que Siru
# lo leyera distinto de lo que dice: encabezados con espacio o minusculas
# (DEFINED PARAMETERS -> DEFINED_PARAMETERS), #include -> include, rutas de
# include relativas al archivo, ; dentro de comentarios (-> ,), Latin-1 o
# UTF-8 doble -> UTF-8, lineas fuera de toda seccion (se comentan). Lo
# demas queda igual: comentarios, ordenes, espacios, END y lo que sigue.
# Los include no se tocan: se arreglan aparte.
#
# Informa cada cambio por la salida de errores; los errores que no puede
# corregir (un include que no existe, una seccion sin parser) tambien, y
# entonces el estado es 1.
#
# Copyright (C) Diego Saravia <dsa@unsa.edu.ar>
# GPL version 3 o posterior.

use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/../lib";
use Getopt::Long qw(GetOptions);
use Simusol::Simulparser;

my ($salida, $nada, $ayuda);
GetOptions('o|salida=s' => \$salida, 'n|nada' => \$nada, 'h|help|ayuda' => \$ayuda)
    or uso(2);
uso(0) if $ayuda;
uso(2) if @ARGV != 1;
my $ds = $ARGV[0];
$salida //= $ds =~ s/\.[^.\/]*\z//r . '.ds2';

my ($texto, $cambios, $errores) = eval { Simusol::Simulparser::arreglar($ds) };
if (not defined $texto) { print STDERR "dsarregla: $@"; exit 1; }
print STDERR "dsarregla: $ds:$_\n" for @$cambios;
print STDERR "dsarregla: $ds:$_ (ERROR, no se corrige)\n" for @$errores;
print STDERR "dsarregla: $ds: sin cambios\n" if not @$cambios and not @$errores;

if (not $nada) {
    if ($salida eq '-') {
        binmode STDOUT, ':encoding(UTF-8)';
        print $texto;
    } else {
        open(my $fh, '>:encoding(UTF-8)', $salida) or die "dsarregla: $salida: $!\n";
        print $fh $texto;
        close $fh;
        print STDERR "dsarregla: escrito $salida\n";
    }
}
exit(@$errores ? 1 : 0);

sub uso {
    my ($estado) = @_;
    my $fh = $estado ? \*STDERR : \*STDOUT;
    print $fh "uso: dsarregla [-n] ARCHIVO.ds [-o SALIDA.ds2 | -o -]\n";
    exit $estado;
}
