# --------------------------------------------------------------
# Prontus CMS
# http://www.prontus.cl
# by Altavoz.net
#
# licensed under LGPL license.
# http://www.prontus.cl/license.html
# --------------------------------------------------------------
# Funciones para manejar urls f5

package lib_urlf5;
use strict;
use utf8;
use DBI;
use glib_dbi_03;

sub insert_url {
    my $base = $_[0];
    my %options = %{$_[1]};
    my $sql = "INSERT INTO URLF5 SET URLF5_TYPE = ?, URLF5_SUBTYPE = ?,";
    $sql .= " URLF5_SUBTYPEID = ?, URLF5_FILE = ?, URLF5_URL = ?";

    $options{'url'} = lc($options{'url'});

    my @params = ($options{'type'}, $options{'subtype'}, $options{'subtype_id'}, $options{'file'}, $options{'url'});
    my $salida = &glib_dbi_03::ejecutar_sql_param($base, $sql, \@params);

    if ($base->errstr) {
        print STDERR "Error al insert urlf5 [".$base->errstr."]\n";
    }
}

sub borrar_url {
    my $base = $_[0];
    my %options = %{$_[1]};
    my $sql = "DELETE FROM URLF5 WHERE 1=1 ";
    my @params;

    if (defined($options{'type'}) && $options{'type'} ne '') {
        $sql .= " AND URLF5_TYPE = ?";
        push @params, $options{'type'};
    }
    if (defined($options{'url'}) && $options{'url'} ne '') {
        $sql .= " AND URLF5_URL = ?";
        push @params, $options{'url'};
    }
    if (defined($options{'file'}) && $options{'file'} ne '') {
        $sql .= " AND URLF5_FILE = ?";
        push @params, $options{'file'};
    }
    if (defined($options{'subtype'}) && $options{'subtype'} ne '') {
        $sql .= " AND URLF5_SUBTYPE = ?";
        push @params, $options{'subtype'};
    }
    if (defined($options{'subtype_id'}) && $options{'subtype_id'} ne '') {
        $sql .= " AND URLF5_SUBTYPEID = ?";
        push @params, $options{'subtype_id'};
    }
    if (scalar(@params) < 1) {
        return "Error al borrar urlf5 [Parametros insuficientes]";
    }

    my $salida = &glib_dbi_03::ejecutar_sql_param($base, $sql, \@params);
    if ($base->errstr) {
        print STDERR "Error al borrar urlf5 [".$base->errstr."]\n";
        return "Error al borrar urlf5 [".$base->errstr."]";
    } else {
        return '';
    }
}

sub actualizar_url {
    my $base = $_[0];
    my %options = %{$_[1]};
    my $sql = "UPDATE URLF5 SET URLF5_URL = ? WHERE 1=1 ";
    my @params = (lc($options{'url'}));

    if (defined($options{'type'}) && $options{'type'} ne '') {
        $sql .= " AND URLF5_TYPE = ?";
        push @params, $options{'type'};
    }
    if (defined($options{'file'}) && $options{'file'} ne '') {
        $sql .= " AND URLF5_FILE = ?";
        push @params, $options{'file'};
    }
    if (defined($options{'subtype'}) && $options{'subtype'} ne '') {
        $sql .= " AND URLF5_SUBTYPE = ?";
        push @params, $options{'subtype'};
    }
    if (defined($options{'subtype_id'}) && $options{'subtype_id'} ne '') {
        $sql .= " AND URLF5_SUBTYPEID = ?";
        push @params, $options{'subtype_id'};
    }

    my $salida = &glib_dbi_03::ejecutar_sql_param($base, $sql, \@params);
    if ($base->errstr) {
        print STDERR "Error al actualizar urlf5 [".$base->errstr."]\n";
        return "Error al actualizar urlf5 [".$base->errstr."]";
    }
}

# Si la url ya existe le agrega un numero al final.
# Si supera los 50 intentos, le agrega un random.
sub verifica_url {
    my ($base, $url) = @_;
    my $nuevo_url = $url;
    my $do_random = 1;

    # Si no existe devuelve altiro la misma.
    if (!&existe_url($base, $url)) {
        return $url;
    }

    # Si la url es mas larga de lo permitido se achica dos caracteres para poder
    # agregar el numerito.
    if (length($url) >= $prontus_varglb::URL_MAX_LENGTH) {
        $nuevo_url = substr($nuevo_url, 0, length($nuevo_url) - 3);
    }

    my $index_from = 0;

    if ($nuevo_url =~ /^(.*?)\-(\d+)$/) {
        $nuevo_url = $1;
        $index_from = $2; # para partir de este numero.
    }

    for (my $x = $index_from; $x <= 50; $x++) {
        my $temp_url = "$nuevo_url-$x"; # /el-url-friendly-1

        if (!&existe_url($base, $temp_url)) { # se termina si no existe este nuevo url.
            $url = $temp_url;
            $do_random = 0;
            last;
        }
    }

    # Esto quiere decir que todas las urls consultadas existieron.
    if ($do_random) {
        if (length($url) >= $prontus_varglb::URL_MAX_LENGTH) {
            $url = substr($url, 0, length($url) - 5);
        }

        $url = "$url-" . &glib_str_03::random_string(5);
    }

    return $url;
}

sub existe_url {
    my ($base, $url) = @_;
    my ($sql, $salida, $count);
    my @params = ($url);

    $sql = "SELECT COUNT(*) as count FROM URLF5 WHERE URLF5_URL = ?";

    $salida = &glib_dbi_03::ejecutar_sql_bind_param($base, $sql, \@params, \($count));
    $salida->fetch;
    $salida->finish;

    return $count;
}

sub get_url_data {
    my ($base, $url) = @_;
    my ($sql, $salida, $count);
    my @params = ($url);

    $sql = "SELECT * FROM URLF5 WHERE URLF5_URL = ?";

    $salida = &glib_dbi_03::ejecutar_sql_param($base, $sql, \@params);

    my $row = $salida->fetchrow_hashref;
    $salida->finish;

    return $row;
}

sub get_url_artic {
    my ($base, $ts) = @_;
    my ($sql, $salida, $url);
    my @params = ($ts);

    $sql = "SELECT URLF5_URL FROM URLF5 WHERE URLF5_TYPE = 'artic' AND URLF5_SUBTYPE = 'artic' AND URLF5_SUBTYPEID = ?";

    $salida = &glib_dbi_03::ejecutar_sql_bind_param($base, $sql, \@params, \($url));
    $salida->fetch;
    $salida->finish;

    return $url;
}

sub get_all_url_list {
    my $base = $_[0];
    my %options = %{$_[1]};
    my @urllist;
    my @params;

    my $filtro = '';
    if ($options{'type'} ne 'all') {
        $filtro .= "WHERE URLF5_TYPE = ?";
        push @params, $options{'type'};
    }

    if ($options{'search'} ne '') {
        if ($filtro eq '') {
            $filtro .= "WHERE";
        } else {
            $filtro .= " AND";
        }
        $filtro .= " (URLF5_URL LIKE ? or URLF5_FILE LIKE ?)";
        push @params, '%'.$options{'search'}.'%', '%'.$options{'search'}.'%';
    }

    my $sql = "SELECT count(URLF5_ID) FROM URLF5 $filtro";
    my $total;
    my $salida = &glib_dbi_03::ejecutar_sql_bind_param($base, $sql, \@params, \($total));
    $salida->fetch;
    $salida->finish;

    $sql = "SELECT URLF5_ID, URLF5_TYPE, URLF5_SUBTYPE, URLF5_SUBTYPEID, URLF5_FILE, URLF5_URL FROM URLF5 $filtro";
    if ($options{'order'} eq 'u' || $options{'order'} eq '') {
        $sql .= " order by URLF5_URL ASC, URLF5_FILE ASC";
    } elsif ($options{'order'} eq 'd') {
        $sql .= " order by URLF5_FILE ASC, URLF5_URL ASC";
    } elsif ($options{'order'} eq 't') {
        $sql .= " order by URLF5_TYPE ASC, URLF5_URL ASC";
    }

    # calculo de paginación
    my $item_x_page = 20;
    my $start = ( ($options{'page'} - 1 ) * $item_x_page);
    $sql .= " LIMIT $start,$item_x_page";

    # variables de salida
    my ($urlf5_id, $urlf5_type, $urlf5_subtype, $urlf5_subtypeid, $urlf5_file, $urlf5_url);
    $salida = &glib_dbi_03::ejecutar_sql_bind_param($base, $sql, \@params, \($urlf5_id, $urlf5_type, $urlf5_subtype, $urlf5_subtypeid, $urlf5_file, $urlf5_url));
    while ($salida->fetch) {
        push (@urllist, {'id' => $urlf5_id, 'url' => $urlf5_url, 'type' => $urlf5_type, 'subtype' => $urlf5_subtype, 'subtypeid' => $urlf5_subtypeid, 'file' => $urlf5_file});
    }
    $salida->finish;

    my %result = (
        'list' => \@urllist,
        'pagination' => {
            'total' => $total,
            'start' => $start + 1,
            'page' => $options{'page'},
            'current' => scalar @urllist
        }
    );

    return \%result;
}

sub get_url_list {
    my $base = $_[0];
    my %options = %{$_[1]};
    my %urllist;
    my @params = ($options{'type'});

    my $sql = "SELECT URLF5_FILE, URLF5_URL FROM URLF5 WHERE URLF5_TYPE = ?";

    if ($options{'subtype'} ne '') {
        $sql .= " AND URLF5_SUBTYPE = ?";
        push @params, $options{'subtype'};

        if ($options{'subtype_id'} ne '') {
            $sql .= " AND URLF5_SUBTYPEID = ?";
            push @params, $options{'subtype_id'};
        } else {
            return \%urllist;
        }
    }

    my ($urlf5_file, $urlf5_url);
    my $salida = &glib_dbi_03::ejecutar_sql_bind_param($base, $sql, \@params, \($urlf5_file, $urlf5_url));
    while ($salida->fetch) {
        $urllist{$urlf5_file} = $urlf5_url;
    }
    $salida->finish;

    return \%urllist;
}

sub get_file_data {
    my ($base, $url) = @_;
    my ($sql, $salida, $count);
    my @params = ($url);

    $sql = "SELECT * FROM URLF5 WHERE URLF5_FILE = ?";

    $salida = &glib_dbi_03::ejecutar_sql_param($base, $sql, \@params);

    my $row = $salida->fetchrow_hashref;
    $salida->finish;

    return $row;
}

sub get_link_tax {
    my ($base, $file, $pagina, $mv) = @_;

    my $file_orig = $file;
    # En la tabla se guarda la pagina 1. Hay que cambiar la pagina por 1 y mantener extension.
    $file =~ s/_\d+(\.\w+)$/_1$1/;
    # print STDERR "file[$file]\n";

    my $urlf5_url;
    my @params = ('tax', $file);
    my $sql = "SELECT URLF5_URL FROM URLF5 WHERE URLF5_TYPE = ? AND URLF5_FILE = ?";
    my $salida = &glib_dbi_03::ejecutar_sql_bind_param($base, $sql, \@params, \($urlf5_url));

    $salida->fetch;
    $salida->finish;
    # print STDERR "get_link_tax pagina[$pagina] friendly[$urlf5_url] -> file[$file_orig]\n";

    if (!$urlf5_url) {
        return $file_orig;
    } else {
        if ($pagina) {
            return "$urlf5_url/p/$pagina";
        } else {
            return $urlf5_url;
        }
    }
}

sub get_link_tag {
    my ($base, $file, $pagina, $mv) = @_;

    my $file_orig = $file;
    # En la tabla se guarda la pagina 1. Hay que cambiar la pagina por 1 y mantener extension.
    $file =~ s/_\d+(\.\w+)$/_1$1/;

    my $urlf5_url;
    my @params = ('tag', $file);
    my $sql = "SELECT URLF5_URL FROM URLF5 WHERE URLF5_TYPE = ? AND URLF5_FILE = ?";
    my $salida = &glib_dbi_03::ejecutar_sql_bind_param($base, $sql, \@params, \($urlf5_url));

    $salida->fetch;
    $salida->finish;
    # print STDERR "get_link_tag pagina[$pagina] friendly[$urlf5_url] -> file[$file_orig]\n";

    if (!$urlf5_url) {
        return $file_orig;
    } else {
        if ($pagina) {
            return "$urlf5_url/p/$pagina";
        } else {
            return $urlf5_url;
        }
    }
}

sub make_url {
    my ($titular, $seccion, $tema, $subtema) = @_;
    my $url = '';

    $titular = &lib_prontus::ajusta_titular_friendly($titular);
    if ($seccion eq '') {
        $url = "/$titular";
    } else {
        $seccion = &lib_prontus::ajusta_titular_friendly($seccion);

        if ($tema ne '') {
            $tema = "/" . &lib_prontus::ajusta_titular_friendly($tema);
        }

        if ($subtema ne '') {
            $subtema = "/" . &lib_prontus::ajusta_titular_friendly($subtema);
        }

        $url = "/$seccion$tema$subtema/$titular";
    }

    if ($prontus_varglb::CONFIG{$prontus_varglb::PRONTUS_ID}{'FRIENDLY_V5_URL_PREFIX'} ne '') {
        # Hay un prefijo, agregarlo antes de la url para verificar.
        $url = "/$prontus_varglb::CONFIG{$prontus_varglb::PRONTUS_ID}{'FRIENDLY_V5_URL_PREFIX'}$url";
    }

    # reemplaza // por /
    $url =~ s#//#/#g;

    # largo maximo de url
    if (length($url) > $prontus_varglb::URL_MAX_LENGTH) {
        $url = substr($url, 0, $prontus_varglb::URL_MAX_LENGTH);
    }

    return lc($url);
}

# $path debe ser el path relativo desde el document root
sub guardar_url {
    my ($bd, $url, $path, $new_type, $new_subtype, $new_subtype_id) = @_;

    # buscamos si este path ya tiene asignada una url
    my ($old_url, $type, $subtype) = ('', '', '');

    if ($new_type eq 'redirect') {
        my $sql = "select URLF5_URL, URLF5_TYPE, URLF5_SUBTYPE from URLF5 where URLF5_FILE = ? and URLF5_URL = ?";
        my @params = ($path, $url);
        my $salida = &glib_dbi_03::ejecutar_sql_bind_param($bd, $sql, \@params, \($old_url, $type, $subtype));
        $salida->fetch;
        $salida->finish;
        # archivo existe, entonces debe ser un rewrite
        # el sistema usado no permite diferenciar si se quiere un redirect para un archivo existente
        # solo permite redirects para urls inexistentes
        if (-f "$prontus_varglb::DIR_SERVER$path") {
            # subtipo de redirect es 200, un rewrite, se cambia aqui para simplificar GUI
            $new_subtype = 200;
        } elsif ($new_subtype == 200 && !-f "$prontus_varglb::DIR_SERVER$path" ){
            # si se intenta un rewrite 200, pero no existe el archivo, debe ser 301 un redirect
            # es posible que esta url no sea valida tampoco
            $new_subtype = 301;
        }
    } else {
        my $sql = "select URLF5_URL, URLF5_TYPE, URLF5_SUBTYPE from URLF5 where URLF5_FILE = ?";
        my @params = ($path);
        my $salida = &glib_dbi_03::ejecutar_sql_bind_param($bd, $sql, \@params, \($old_url, $type, $subtype));
        $salida->fetch;
        $salida->finish;
    }

    my $symlink;
    my $fullPath;
    print STDERR "Valores URL [$new_subtype] eq [$subtype] && [$new_type] eq [$type] && [$old_url] eq [$url]\n";
    # el path tiene url, la url es la misma y ya existe en bd, solo trata de recrear symlinks
    if ($new_type eq $type && $old_url eq $url) {
        # se intenta recrear el link, en caso de cambio de tipo, se borra y se crea con el nuevo tipo
        my ($res, $data, $msg);
        if ($url ne '/') {
            ($res, $data, $msg) = &lib_friendly::insertFriendly($url, $path, $new_subtype);
        } else {
            ($res, $data, $msg) = (0, '/', '');
        }
        print STDERR "Params ($url, $path, $new_subtype) insertFriendly($res, $data, $msg)\n";

        if ($res == 1) {
            # la url y el path de destino son el mismo pero cambia el tipo de redirect
            # hay que actualizar la bd con el nuevo tipo
            if ($new_subtype ne $subtype) {
                my $stamp = glib_hrfec_03::get_dtime_pack4();
                my @params = ($new_subtype, $stamp, 'redirect', $path, $url);
                my $sql = "UPDATE URLF5 SET URLF5_SUBTYPE = ?, URLF5_SUBTYPEID = ? WHERE URLF5_TYPE = ? AND URLF5_FILE = ? AND URLF5_URL = ?";
                my $salida = &glib_dbi_03::ejecutar_sql_param($bd, $sql, \@params);
                $salida->finish;

                if ($bd->errstr) {
                    print STDERR "Error al ejecutar [$sql] [".$bd->errstr."]\n";
                    return (0, "Ha ocurrido un error al actualizar");
                }
            }

            return (1, $data);
        } elsif ($res == 0) {
            $symlink = "$prontus_varglb::DIR_SERVER$url/index.html";
            $symlink =~ s|//+|/|g;
            $fullPath = "$prontus_varglb::DIR_SERVER$path";
            $fullPath =~ s|//+|/|g;
            # borrar link simbolico
            unlink $symlink;

            # recrear link
            my $cmd = "ln -sr $fullPath $symlink 2>&1";
            my $result = `$cmd`;
            return (1, $path);
        } else {
            print STDERR "Error ($url, $path, $new_subtype) insertFriendly($res, $data, $msg)\n";
            return (0, "Error al crear la URL 1:[$msg]");
        }
    }
    # el path tiene asignada una url pero no es la misma que la que se guarda, hay que actualizar y borrar el link anterior
    elsif (!defined($old_url) || $old_url ne $url) {
        # nueva url, revisamos si hay conflicto
        my @params = ($url);
        my $sql = "select count(*) from URLF5 where URLF5_URL = ?";
        my $count = 0;
        my $salida = &glib_dbi_03::ejecutar_sql_param($bd, $sql, \@params, \($count));
        $salida->fetch;
        $salida->finish;

        if ($bd->errstr) {
            print STDERR "Error al ejecutar [$sql] [".$bd->errstr."]\n";
            return (0, "Ha ocurrido un error en la consulta");
        }

        my $newtypeDir = 0;
        my ($res, $data, $msg);
        # no existe conflicto en BD revisamos en links friendly
        if ($count == 0) {
            # Chequea URL.
            if ($url ne '/') {
                ($res, $data, $msg) = &lib_friendly::readFriendly($url);
            } else {
                # si la url se esta asignando a la raiz del sitio
                ($res, $data, $msg) = (5, '/', '');
            }
            if ($res == 5) {
                $newtypeDir = 1;
                $symlink = "$prontus_varglb::DIR_SERVER$url/index.html";
                $symlink =~ s|//+|/|g;
                $fullPath = "$prontus_varglb::DIR_SERVER$path";
                $fullPath =~ s|//+|/|g;

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

                    if ($fullPath ne $linkPath ) {
                        print STDERR "[$url] hay un link en conflicto [$symlink, $linkPath]\n";
                        return (0, "La URL ya existe.");
                    }
                } elsif (-f $symlink) {
                    print STDERR "[$url] hay un archivo real en conflicto [$symlink]\n";
                    return (0, "La URL ya existe.");
                }
            }
            # hay un link en conflicto
            elsif ($res != 0) {
                print STDERR "[$url] hay un link en conflicto [$res, $data, $msg]\n";
                return (0, "La URL ya existe.");
            }
        } else {
            # existe un conflicto en BD
            print STDERR "[$url] existe un conflicto en BD\n";
            return (0, "La URL ya existe.");
        }

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

        print STDERR "Params 2 ($url, $path, $new_subtype) readFriendly($res, $data, $msg)\n";
        if ($res == 5) {
            $typeDir = 1;
        }

        # no existe ningun conflicto, se intenta guardar el nuevo link
        # borra antigua url
        if ($old_url ne '') {
            if (!$typeDir) {
                ($res, $msg) = &lib_friendly::deleteFriendly($old_url);
                if ($res == 0) {
                    return (0, "Error al crear la URL 2:[$msg]");
                }
            } else {
                my $oldLink = "$prontus_varglb::DIR_SERVER$old_url/index.html";
                $oldLink =~ s|//+|/|g;
                # borrar link simbolico
                unlink $oldLink;
            }
        }

        # crea nuevo
        if (!$newtypeDir) {
            ($res, $data, $msg) = &lib_friendly::insertFriendly($url, $path, $new_subtype);
        } else {
            my $cmd = "ln -sr $fullPath $symlink 2>&1";
            my $result = `$cmd`;
            $data = $path;
            # corresponde a creacion ok
            $res = 1;
        }
        if ($res == 1) {
            my %options = (
                'type'          => $new_type,
                'subtype'       => $new_subtype,
                'subtype_id'    => $new_subtype_id,
                'file'          => $path,
                'url'           => $url,
            );

            if ($old_url ne '') {
                &actualizar_url($bd, \%options);
            } else {
                &insert_url($bd, \%options);
            }

            # Si es tax, regenerar json de tax para actualizar las friendly v5.
            if ($new_type eq 'tax') {
                &lib_tax::generar_json($bd);
            } elsif ($new_type eq 'tag') {
                # Si es un tag, regenerar json de tags para actualizar las friendly v5.
                &lib_tags::generar_json($bd);
            }

            return (1, $data);
        } else {
            return (0, "Error al crear la URL 3:[$msg]");
        }
    } else {
        return (0, "Error al crear la URL 4");
    }
}

sub valida_type {
    my $type = $_[0];
    return $type =~ /^tax|tag|list|port|artic|redirect$/;
}

1;
