#!/usr/bin/perl

# --------------------------------------------------------------
# Prontus CMS
# http://www.prontus.cl
# by Altavoz.net
#
# licensed under LGPL license.
# http://www.prontus.cl/license.html
# --------------------------------------------------------------

package lib_stdlog;
use strict;
use utf8;
use warnings;
use File::Copy;
use glib_fildir_03;
use glib_hrfec_03;

our $PATH_LOG = '';

# ---------------------------------------------------------------
sub set_stdlog {
# Implementa log de errores para cgi
# Si hay mas de 10 historicos, borra el mas antiguo para que no se acumulen.
    my $path_script = shift;    # habitualmente $0
    my $max_size    = shift;    # habitualmente 51200 (50k)
    my $nom_dir4log = shift;    # optativo

    $path_script = $0 if (!defined($path_script));
    $max_size = 51200 if (!defined($max_size));
    $nom_dir4log = 'prontus_error_log' if (!defined($nom_dir4log));

    my $log_file;
    my $dir = '';
    if ($path_script =~ /((.+)\/)?(\w+\.\w+)$/) {
        $dir = defined($2)?$2:'';
        $log_file = "$3.error.log";
    } else {
        $log_file = 'error.log';
    }

    if ($dir eq '') {
        # usa document root si esta disponible, si no, intenta con findbin
        if (defined($ENV{'DOCUMENT_ROOT'})) {
            $dir = $ENV{'DOCUMENT_ROOT'};
            # document root existe, dejamos logs en cgi-cpn como base
            $dir = "$dir/cgi-cpn";
        } else {
            # para linea de comandos
            use FindBin qw($Bin);
            $dir = $Bin; # por ej /sites/misitio.cl/web/cgi-cpn
        }
    }
    $dir = "$dir/$nom_dir4log";

    &glib_fildir_03::check_dir($dir) || return 0;

    $PATH_LOG = "$dir/$log_file";

    if (-f $PATH_LOG && (-s $PATH_LOG) > $max_size) {
        my $ts_file = &glib_hrfec_03::get_dtime_pack4();
        &File::Copy::move($PATH_LOG, "$PATH_LOG.$ts_file");    # lo rota
    }

    if (!-f $PATH_LOG) {
        # abre el nuevo
        open(STDERR, '>', $PATH_LOG);
        binmode STDERR, ':encoding(UTF-8)';
        # borra el mas antiguo si es q hay mas de 10
        &do_garbage($dir, $log_file);
    } else {
        open(STDERR, ">>:encoding(UTF-8)", $PATH_LOG);
    }
}
# ---------------------------------------------------------------
sub do_garbage {
    # garbage
    my $dir     = shift;
    my $nom_log = shift;

    # print STDERR "dir[$dir] nom_pattern[$nom_pattern]\n";
    opendir(DIRHANDLE, $dir) || warn "ERROR: no se puede leer directorio actual\n";
    my @dir_list     = readdir(DIRHANDLE);
    my @dir_list_out = sort grep(/^$nom_log\.\d{14}$/, @dir_list);    # de menor a mayor
    my $num_files    = scalar @dir_list_out;
    # print STDERR "num_files[$num_files]\n";
    if ($num_files > 10) {
        if ($num_files == 11) {
            # borra el mas antiguo que es el primero de la lista
            print STDERR "borrando[$dir_list_out[0]]\n";
            unlink "$dir/$dir_list_out[0]";
        } else {
            # Si hay mas de 11 los borra todos hasta dejar solo 10
            for (my $i = 0 ; $i < ($num_files - 10) ; $i++) {
                print STDERR "borrando[$dir_list_out[$i]]\n";
                unlink "$dir/$dir_list_out[$i]";
            }
        }
    }
}

1;
