#!/usr/bin/perl

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

# ---------------------------------------------------------------
# PROPOSITO
# ---------------------------------------------------------------
# Regenerar los link simbolicos de friendly url de artículos, portadas, listas, taxonomias y tags.
#
# INVOCACION
#
# perl prontus_urlf5_regen.pl <prontus_id> <all|artic|tax|tag|port|list|redirect>
#
# solo para all y artic se puede especificar un rango
# perl prontus_urlf5_regen.pl <prontus_id> all <hasta> <desde>
# perl prontus_urlf5_regen.pl <prontus_id> artic <hasta> <desde>
#
use strict;
use utf8;

BEGIN {
    use FindBin qw($Bin);
    unshift(@INC,$Bin); # Para dejar disponibles las librerias
    my $pathLibsProntus = $Bin;
    $pathLibsProntus =~ s/\/[^\/]+\/?$//;
    unshift(@INC,$pathLibsProntus); # Para dejar disponibles las librerias de prontus
}

use lib_prontus;
# Captura STDERR
use lib_stdlog;
lib_stdlog::set_stdlog($0, 51200);

use DBI;

use prontus_varglb; &prontus_varglb::init();
use glib_hrfec_03;
use glib_html_03;
use glib_fildir_03;
use lib_friendly;
use lib_urlf5;
use Artic;

my $BD;
my %REGISTRO;
my %CONFLICTOS;

main: {
    &lib_prontus::setUtf8();
    $prontus_varglb::PRONTUS_ID = $ARGV[0];
    my $tipo = $ARGV[1];
    my $until = $ARGV[2] || '';
    my $from = $ARGV[3] || '';

    $tipo = 'all' if (!$tipo);

    my $msg_load = &lib_prontus::load_config_by_id($prontus_varglb::PRONTUS_ID);
    if ($msg_load ne '') {
        print STDERR "Error: $msg_load\n";
        print "Error: $msg_load\n";
        exit;
    }

    if ($prontus_varglb::CONFIG{$prontus_varglb::PRONTUS_ID}{'FRIENDLY_URLS_VERSION'} ne '5') {
        print "Prontus [$prontus_varglb::PRONTUS_ID] no tiene friendly url v5 activada\n";
        exit;
    }

    my $msg_err_bd;
    ($BD, $msg_err_bd) = &lib_prontus::conectar_prontus_bd();
    if (!ref($BD)) {
        print "Error conectar BD: $msg_err_bd\n";
        exit;
    }

    my @vistas = (keys %{$prontus_varglb::CONFIG{$prontus_varglb::PRONTUS_ID}{'MULTIVISTAS'}});
    &lib_friendly::init($prontus_varglb::DIR_SERVER, $prontus_varglb::DIR_FRIENDLY5, \@vistas);

    if ($tipo eq 'all') {
        &regen_urlf5_artic($until, $from);
        &regen_urlf5_tax('seccion');
        &regen_urlf5_tax('tema');
        &regen_urlf5_tax('subtema');
        &regen_urlf5_tag();
        &regen_urlf5_port();
        &regen_urlf5_list();
        &regen_urlf5_redir($until, $from);
    } elsif ($tipo eq 'artic') {
        &regen_urlf5_artic($until, $from);
    } elsif ($tipo eq 'tax') {
        &regen_urlf5_tax('seccion');
        &regen_urlf5_tax('tema');
        &regen_urlf5_tax('subtema');
    } elsif ($tipo eq 'tag') {
        &regen_urlf5_tag();
    } elsif ($tipo eq 'port') {
        &regen_urlf5_port();
    } elsif ($tipo eq 'list') {
        &regen_urlf5_list();
    } elsif ($tipo eq 'redirect') {
        &regen_urlf5_redir($until, $from);
    } else {
        print "ERROR: Tipo inválido.\n";
        exit;
    }

    my $tot_conflictos = scalar keys %CONFLICTOS;
    my $tot_registro = scalar keys %REGISTRO;

    print "\nTotal procesados: $tot_registro\n";
    print "Total conflictos: $tot_conflictos\n";

    if ($tot_conflictos) {
        foreach my $url (keys %CONFLICTOS) {
            $CONFLICTOS{$url} =~ s/,$//;

            print "$url -> $CONFLICTOS{$url}\n";
        }
    }
}

# regenera links de redirecciones
sub regen_urlf5_redir {
    my ($until, $from) = @_;
    my $sql = "SELECT URLF5_URL, URLF5_FILE, URLF5_SUBTYPE FROM URLF5 WHERE URLF5_TYPE = ?";
    my @params = ('redirect');
    if ($from && length($from) < 14) {
        $from .= '0'x(14 - length($from));
        $sql .= "and URLF5_SUBTYPEID < ?";
        push(@params, $from);
    }
    if ($until && length($until) < 14) {
        $until .= '0'x(14 - length($until));
        $sql .= "and URLF5_SUBTYPEID > ?";
        push(@params, $until);
    }
    $sql .= " order by URLF5_SUBTYPEID desc";

    my $salida = &glib_dbi_03::ejecutar_sql_param($BD, $sql, \@params);
    if ($BD->errstr) {
        print "Error al obtener listado de urls, no se pueden regenerar las redirecciones:[", $BD->errstr, "]\n";
        return;
    }

    while (my $row = $salida->fetchrow_hashref) {
        my ($res, $data, $msg);
        print "procesando urlf5_url[".$row->{'URLF5_URL'}."] urlf5_file[".$row->{'URLF5_FILE'}."]...\n";

        ($res,$msg) = &lib_friendly::deleteFriendly($row->{'URLF5_URL'});
        ($res,$data,$msg) = &lib_friendly::insertFriendly($row->{'URLF5_URL'}, $row->{'URLF5_FILE'}, $row->{'URLF5_SUBTYPE'});
        if ($res == 0) {
            print "Error al crear friendly [$res][$msg] url[",$row->{'URLF5_FILE'},"]\n";
            $CONFLICTOS{$row->{'URLF5_URL'}} .= $row->{'URLF5_FILE'};
        } else {
            print "\t[",$row->{'URLF5_URL'},"] Redirect: Friendy 301 creada.\n";
            if (!exists $REGISTRO{$row->{'URLF5_URL'}}) {
                $REGISTRO{$row->{'URLF5_URL'}} = $row->{'URLF5_FILE'};
            }
        }
    }
    $salida->finish;
}

#
# crea los links simbolicos para los articulos usando la información guardada en bd
# no modifica los xmls ni los datos de bd
sub regen_urlf5_artic {
    my ($until, $from) = @_;
    # se buscan los registros artic en la tabla de URLF5
    my $sql = "SELECT URLF5_URL, URLF5_FILE, URLF5_SUBTYPEID FROM URLF5 WHERE URLF5_TYPE = ?";
    my @params = ('artic');
    if ($from && length($from) < 14) {
        $from .= '0'x(14 - length($from));
        $sql .= "and URLF5_SUBTYPEID < ?";
        push(@params, $from);
    }
    if ($until && length($until) < 14) {
        $until .= '0'x(14 - length($until));
        $sql .= "and URLF5_SUBTYPEID > ?";
        push(@params, $until);
    }
    $sql .= " order by URLF5_SUBTYPEID desc";

    my $salida = &glib_dbi_03::ejecutar_sql_param($BD, $sql, \@params);
    if ($BD->errstr) {
        print "Error al obtener listado de urls, no se pueden regenerar urls F5 de artículos:[", $BD->errstr, "]\n";
        return;
    }

    while (my $row = $salida->fetchrow_hashref) {
        my $artic_obj;
        unless($artic_obj = Artic->new(
                    'prontus_id'         => $prontus_varglb::PRONTUS_ID,
                    'public_server_name' => $prontus_varglb::CONFIG{$prontus_varglb::PRONTUS_ID}{'PUBLIC_SERVER_NAME'},
                    'cpan_server_name'   => $prontus_varglb::CONFIG{$prontus_varglb::PRONTUS_ID}{'CPAN_SERVER_NAME'},
                    'document_root'      => $prontus_varglb::DIR_SERVER,
                    'ts'                 => $row->{'URLF5_SUBTYPEID'},
                    'no_check_dirs'      => 1)) {
            print STDERR "[Error] inicializando objeto articulo: $Artic::ERR\n";
            next;
        };

        # el articulo no está publicado por lo tanto no hay que crear el link
        if (!$artic_obj->check_publish_art()) {
            next;
        }

        my ($res, $data, $msg) = &lib_friendly::insertFriendly($row->{'URLF5_URL'}, $row->{'URLF5_FILE'}, $row->{'URLF5_SUBTYPE'});
        if ($res == 0) {
            print "Error al crear friendly de articulo [$res][$msg] ts[",$row->{'URLF5_SUBTYPEID'},"]\n";
            $CONFLICTOS{$row->{'URLF5_URL'}} .= $row->{'URLF5_SUBTYPEID'};
        } else {
            print "[",$row->{'URLF5_SUBTYPEID'},"] Friendy creada.\n";
            if (!exists $REGISTRO{$row->{'URLF5_URL'}}) {
                $REGISTRO{$row->{'URLF5_URL'}} = $row->{'URLF5_FILE'};
            }
        }
    }
    $salida->finish;
}
# crea links correspondientes a urls de taxonomia
sub regen_urlf5_tax {
    my $subtype = $_[0];
    my $sql = "SELECT URLF5_FILE, URLF5_URL FROM URLF5 WHERE ";
    $sql .= "URLF5_TYPE = ? AND URLF5_SUBTYPE = ?";
    my $urlf5_file;
    my $urlf5_url;
    my @params = ('tax', $subtype);

    my $salida = &glib_dbi_03::ejecutar_sql_bind_param($BD, $sql, \@params, \($urlf5_file, $urlf5_url));

    while ($salida->fetch) {
        print "procesando urlf5_url[$urlf5_url] urlf5_file[$urlf5_file]...\n";

        my ($res, $path, $msg) = &lib_friendly::readFriendly($urlf5_url);
        if ($res == 0) {
            my ($res, $data, $msg) = &lib_friendly::insertFriendly($urlf5_url, $urlf5_file, 200);
            # print "res[$res] data[$data] msg[$msg]\n";

            if ($res == 1) {
                print "\tFriendy creada.\n";
            } else {
                print "\tNo se pudo crear friendly [$msg].\n";
            }
        } else {
            print "\tYa existe link simbólico para [$urlf5_url].\n";
        }

        # Lleva registro de las urls procesadas.
        if (!exists $REGISTRO{$urlf5_url}) {
            $REGISTRO{$urlf5_url} = $urlf5_file;
        }
    }

    $salida->finish;
}

# regenera links de portadas tagonomicas
sub regen_urlf5_tag {
    my $sql = "SELECT URLF5_FILE, URLF5_URL FROM URLF5 WHERE ";
    $sql .= "URLF5_TYPE = ? AND URLF5_SUBTYPE = ?";
    my $urlf5_file;
    my $urlf5_url;
    my @params = ('tag', 'tag');

    my $salida = &glib_dbi_03::ejecutar_sql_bind_param($BD, $sql, \@params, \($urlf5_file, $urlf5_url));

    while ($salida->fetch) {
        print "procesando urlf5_url[$urlf5_url] urlf5_file[$urlf5_file]...\n";

        my ($res, $path, $msg) = &lib_friendly::readFriendly($urlf5_url);

        if ($res == 0) {
            my ($res, $data, $msg) = &lib_friendly::insertFriendly($urlf5_url, $urlf5_file, 200);

            # print "res[$res] data[$data] msg[$msg]\n";

            if ($res == 1) {
                print "\tFriendy creada.\n";
            } else {
                print "\tNo se pudo crear friendly [$msg].\n";
            }
        } else {
            print "\tYa existe link simbólico para [$urlf5_url].\n";
        }

        if (!exists $REGISTRO{$urlf5_url}) {
            $REGISTRO{$urlf5_url} = $urlf5_file;
        } else {
            $CONFLICTOS{$urlf5_url} .= "$urlf5_file,";
        }
    }

    $salida->finish;
}

sub regen_urlf5_port {
    my $sql = "SELECT URLF5_FILE, URLF5_URL FROM URLF5 WHERE ";
    $sql .= "URLF5_TYPE = ? AND URLF5_SUBTYPE = ?";
    my $urlf5_file;
    my $urlf5_url;
    my @params = ('port', 'port');

    my $salida = &glib_dbi_03::ejecutar_sql_bind_param($BD, $sql, \@params, \($urlf5_file, $urlf5_url));

    while ($salida->fetch) {
        print "procesando urlf5_url[$urlf5_url] urlf5_file[$urlf5_file]...\n";

        my ($res, $path, $msg);
        # Chequea URL.
        if ($urlf5_url ne '/') {
            ($res, $path, $msg) = lib_friendly::readFriendly($urlf5_url);
        } else {
            # si la url se esta asignando a la raiz del sitio
            ($res, $path, $msg) = (5, '/', '');
        }

        if ($res == 5) {
            print "\tCrear Friendy .\n";
            my $symlink = "$prontus_varglb::DIR_SERVER$urlf5_url/index.html";
            $symlink =~ s|//+|/|g;
            my $fullPath = "$prontus_varglb::DIR_SERVER$urlf5_file";
            $fullPath =~ s|//+|/|g;

            if (-l $symlink) {
                my $linkPath = readlink $symlink;
                # Elimina referencias a directorios hacia atras.
                $linkPath =~ s/^(\.\.\/)+//;
                $linkPath = "$prontus_varglb::DIR_SERVER$urlf5_url/$linkPath";
                $linkPath =~ s|//+|/|g;

                if ($fullPath ne $linkPath ) {
                    print "[$urlf5_url] hay un link en conflicto [$symlink, $linkPath][$fullPath ne $linkPath]\n";
                    print "La URL está en uso.\n";
                }
            } elsif (-f $symlink) {
                print "[$urlf5_url] hay un archivo real en conflicto [$symlink]\n";
                print "La URL ya existe por otro archivo.\n";
            } else {
                my $cmd = "ln -sr $fullPath $symlink 2>&1";
                my $result = `$cmd`;
                # corresponde a creacion ok
                print "\tFriendy creada1.\n";
            }

        } elsif ($res == 0) {
            my ($res, $data, $msg) = &lib_friendly::insertFriendly($urlf5_url, $urlf5_file, 200);

            # print "res[$res] data[$data] msg[$msg]\n";

            if ($res == 1) {
                print "\tFriendy creada.\n";
            } else {
                print "\tNo se pudo crear friendly [$msg].\n";
            }
        } else {
            print "\tYa existe link simbólico para [$urlf5_url][$res].\n";
        }

        if (!exists $REGISTRO{$urlf5_url}) {
            $REGISTRO{$urlf5_url} = $urlf5_file;
        } else {
            $CONFLICTOS{$urlf5_url} .= "$urlf5_file,";
        }
    }

    $salida->finish;
}

sub regen_urlf5_list {
    my $sql = "SELECT URLF5_FILE, URLF5_URL FROM URLF5 WHERE ";
    $sql .= "URLF5_TYPE = ? AND URLF5_SUBTYPE = ?";
    my $urlf5_file;
    my $urlf5_url;
    my @params = ('list', 'list');

    my $salida = &glib_dbi_03::ejecutar_sql_bind_param($BD, $sql, \@params, \($urlf5_file, $urlf5_url));

    while ($salida->fetch) {
        print "procesando urlf5_url[$urlf5_url] urlf5_file[$urlf5_file]...\n";

        my ($res, $path, $msg) = &lib_friendly::readFriendly($urlf5_url);

        if ($res == 0) {
            my ($res, $data, $msg) = &lib_friendly::insertFriendly($urlf5_url, $urlf5_file, 200);
            # print "res[$res] data[$data] msg[$msg]\n";

            if ($res == 1) {
                print "\tFriendy creada.\n";
            } else {
                print "\tNo se pudo crear friendly [$msg].\n";
            }
        } else {
            print "\tYa existe link simbólico para [$urlf5_url].\n";
        }

        if (!exists $REGISTRO{$urlf5_url}) {
            $REGISTRO{$urlf5_url} = $urlf5_file;
        } else {
            $CONFLICTOS{$urlf5_url} .= "$urlf5_file,";
        }
    }

    $salida->finish;
}
