#!/usr/bin/perl
package lib_friendly;
#
# Contiene los servicios de verificacion y creacion de friendly URLs arbitrarios.
#
# Historia de versiones:
# 1.0.0 - 2019-06-26 - ALD - Primera version.
# 1.1.0 - 2019-06-28 - ALD - Maneja resultado 5 en insertFriendly.
# 1.2.0 - 2019-07-09 - ALD - Si el path no existe, crea un archivo de tamano 0 para
#                            permitir la creacion de friendlies para portadas que todavia
#                            no existen, como las tax.
# 1.2.1 - 2019-10-11 - JOR - Corrige regexp de vistas.
# 1.3.0 - 2019-12-04 - ALD - Agrega flag para impedir la creacion de archivos de tamano 0 para
#                            los casos en los que se necesita crear una referencia a un URL antiguo.
#                            Este cambio es retrocompatible, ya que si el flag no existe,
#                            entonces se puede crear el archivo.
#                          - Si no encuentra un path, vuelve a buscarlo por si es URL
#                            antiguo (en readFriendly).
# 1.4.0 - 2019-12-06 - ALD - Considera caso de las taxport dinamicas.
# 1.5.0 - 2020-03-03 - ALD - Implementa respuesta extra en readFriendly para el caso de que el
#                            friendly traiga un trailing slash y que existe al friendly.
#                            Esta respuesta debe generar un redirect 302 en el handler.
# 1.5.1 - 2020-03-03 - ALD - Implementa respuesta 7 en vez de agregar otra variable en la respuesta.
# 1.5.2 - 2020-03-04 - ALD - Implementa respuesta 7 tambien para taxports dinamicas.

use strict;
use warnings;
use utf8;

use Digest::MD5 qw(md5_hex);

# Document root.
# Debe ser inicializado antes de usar el modulo.
our $ROOTDIR;

# Directorio de los links friendly en el disco.
# Debe ser inicializado antes de usar el modulo.
our $F5DIR;
# directorio de links 302
our $DIR302 = "h302";
# Prefijo de vista.
# Debe ser inicializado antes de usar el modulo.
our @VISTAS;

# Patrones de paths que llevan vista.
# TODO revisar regexp de vistas path, debiesen tener un ^ al principio y $ al final.
our @VISTAS_PATHS = (
    '([\.\/\w\-]+\/site\/artic\/\d+\/pags)(\/[\w\.\-\/]+)',     # Articulos
    '([\.\/\w\-]+\/site\/edic\/[\w\-]+\/port)(\/[\w\.\-\/]+)',  # Portadas
    '([\.\/\w\-]+\/site\/tax\/port\/[\w\-]+)(\/[\w\.\-\/]+)',   # Categorias
    '([\.\/\w\-]+\/site\/tag\/port\/[\w\-]+)(\/[\w\.\-\/]+)',   # Tags
    '([\.\/\w\-]+\/site\/extra\/[\w\-]+\/pags)(\/[\w\.\-\/]+)'  # Extras
);

#------------------------------------------------------------------------------#
# Inicializa variables globales.
sub init {
    $ROOTDIR = $_[0];
    $F5DIR = $_[0].$_[1];
    @VISTAS = @{$_[2]};
} # init

#------------------------------------------------------------------------------#
# Lee el link simbolico del friendly.
# Retorna un arreglo con un status, un dato, un mensaje y el url friendly sin slash si tiene que hacer redirect.
# 0 '' y un mensaje si el friendly no existe.
# 1 el path al archivo real final, un msg si el friendly existe y el url friendly para hacer redirect.
# 2 el path al archivo y un msg si el link existe, pero la pagina del archivo no.
# 3 el path al archivo y un msg si el link existe, pero la vista del archivo no.
# 4 el path y un msg si el link existe, pero el archivo de destino no.
# 5 el path y un msg si se trata de un path real.
# 6 el path y un msg recomendando hacer un redirect 301 al path.
# 7 el path y un msg recomendando hacer un redirect 302 al path.
# 8 el md5 correspondiente es un archivo
# 9 el md5 correspondiente es un directorio
sub readFriendly {
    my ($friendly,$noFollow) = @_;
    my ($vista,$pag,$composedPath,$isPaged);
    my ($res,$data,$msg);
    my ($hasTrailingSlash,$originalFriendly) = (0,''); # 1.5.1

    if ($friendly ne '/') {
        # 1.5.0 Elimina posible(s) trailing slash(es) y lo recuerda.
        $hasTrailingSlash = ($friendly =~ s/(.+)\/$/$1/g);
        # Recuerda el friendly original sin slash por si tiene que reportarlo para hacer un redirect.
        $originalFriendly = $friendly;

        # Verifica si el archivo o directorio fisico existe.
        if ((-f "$ROOTDIR$friendly") || (-d "$ROOTDIR$friendly")) {
            # Si existe, retorna error.
            return (5,$friendly,'El url consultado corresponde a un archivo o directorio físico');
        }
    }
    # print STDERR "1 friendly = [$friendly]\n"; # debug

    # Detecta si se esta solicitando un friendly con vista, separando
    # la vista del friendly sin vista.
    ($vista,$friendly) = &getVista($friendly);
    #  print STDERR "2 vista = [$vista] friendly = [$friendly]\n"; # debug

    # Detecta si se esta solicitando un friendly con pagina, separando
    # la pagina del friendly sin pagina.
    ($pag,$friendly) = &getPag($friendly);
    # print STDERR "3 pag = [$pag] friendly = [$friendly]\n"; # debug

    # Crea el MD5.
    my $md5 = Digest::MD5::md5_hex($friendly);
    # print STDERR "4 md5 = [$md5] friendly = [$friendly]\n"; # debug

    # Compone el path del symlink.
    my $symlink = $F5DIR .'/'. substr($md5,0,2) .'/'. substr($md5,2,2) .'/'. $md5;
    # print STDERR "[$friendly] -> symlink [$symlink]\n";
    my $symlink_302 = $F5DIR ."/$DIR302/". substr($md5,0,2) .'/'. substr($md5,2,2) .'/'. $md5;
    # print STDERR "symlink_302 [$symlink_302]\n";

    # Verifica si el symlink existe.
    if (-l $symlink) {
        my $linkPath = readlink $symlink;
        # Elimina referencias a directorios hacia atras.
        $linkPath =~ s/^(\.\.\/)+//;
        # Pega rootdir para verificar archivo fisico.
        my $realPath = "$ROOTDIR/$linkPath";
        # Verifica si el archivo fisico base existe.
        if ($linkPath =~ /\/site\/tax\/port\//) { # 1.4.0
            $composedPath = &insertVista($vista,$realPath);
            if ($pag ne '') {
                ($composedPath,$isPaged) = &insertPag($pag,$composedPath);
            }
            $composedPath =~ s/^$ROOTDIR//;
            # archivo no existe se debe generar
            if (!-f "$ROOTDIR/$composedPath") {
                my $cmd = "/usr/bin/perl $ROOTDIR/cgi-bin/prontus_make_taxport.cgi $composedPath";
                system $cmd;
            }
            $res = 1;
            $data = $composedPath;
            $msg = 'Caso especial: Taxport dinamica.';
            # 1.5.2 Si el friendly original tenia un trailing slash, reporta el
            # url sin slash para hacer el redirect.
            if ($hasTrailingSlash) {
                $res = 7;
                $data = $originalFriendly;
                $msg = 'Friendly invocado con trailing slash. Debe redirigir.';
            }
        }elsif (-f $realPath) {
            # Inserta la vista en el path.
            $composedPath = &insertVista($vista,$realPath);
            # Verifica si el path con vista existe.
            if (-f $composedPath) {
                # Inserta la pagina en el path, si existe.
                if ($pag ne '') {
                    # print "4 pag = [$pag] realPath = [$realPath]\n"; # debug
                    ($composedPath,$isPaged) = &insertPag($pag,$composedPath);
                    # Verifica si el path con (posible) vista y (posible) pagina existe.
                    if ((-f $composedPath) && ($isPaged == 1)) {
                        $res = 1;
                        $data = $composedPath;
                        $msg = 'Friendly existe, solicitado con paginacion.';
                        # 1.5.0 Si el friendly original tenia un trailing slash, reporta el
                        # url sin slash para hacer el redirect.
                        if ($hasTrailingSlash) {
                            $res = 7;
                            $data = $originalFriendly;
                            $msg = 'Friendly invocado con trailing slash. Debe redirigir.';
                        }
                    }else{
                        $res = 2;
                        $data = $realPath;
                        $msg = 'Archivo fisico base existe, pero la pagina no existe o el url no admite paginacion.';
                    }
                }else{
                    $res = 1;
                    $data = $composedPath;
                    $msg = 'Archivo fisico base existe, solicitado sin paginacion';
                    # 1.5.0 Si el friendly original tenia un trailing slash, reporta el
                    # url sin slash para hacer el redirect.
                    if ($hasTrailingSlash) {
                        $res = 7;
                        $data = $originalFriendly;
                        $msg = 'Friendly invocado con trailing slash. Debe redirigir.';
                    }
                }
            }else{
                $res = 3;
                $data = $composedPath;
                $msg = 'Archivo fisico base existe, pero la vista [' . $vista . '] no existe';
            }
        }elsif (! $noFollow) {
            # Si es la primera invocacion (no hay flag $noFollow), vuelve a buscar por el
            # path encontrado, por si es antiguo, pero insertando el flag $noFollow.
            ($res,$data,$msg) = &readFriendly("/$linkPath",1);
            # Si encontro el friendly, altera el resultado para poder hacer un redirect 301.
            if ( ($res == 1) || ($res == 2) || ($res == 3) || ($res == 5) ) {
                $res = 6;
                # Entrega el URL anterior para que se pueda responder con un redirect 301 en el server.
                $data = "/$linkPath";
                $msg = 'Friendly es redirect 301';
            }
        }else{
            $res = 4;
            $data = $realPath;
            $msg = "Link existe, pero el archivo fisico base [$realPath] no existe";
        }
    }elsif (-l $symlink_302) {
        # es un redirect 302
        my $linkPath = readlink $symlink_302;
        # Elimina referencias a directorios hacia atras.
        $linkPath =~ s/^(\.\.\/)+//;
        $res = 7;
        $data = "/$linkPath";
        $msg = 'Friendly es redirect 302';
    }elsif (-f $symlink) {
        $res = 8;
        $data = $symlink;
        $msg = 'Friendly es archivo';
    }elsif (-d $symlink) {
        $res = 9;
        $data = $symlink;
        $msg = 'Friendly es directorio';
    }else{
        $res = 0;
        $data = $symlink;
        $msg = 'Friendly no existe';
    }

    # Elimina el docroot del resultado.
    $data =~ s/^$ROOTDIR//;

    return ($res,$data,$msg);

} # readFriendly

#------------------------------------------------------------------------------#
# Crea el link simbolico del friendly.
# Retorna un status y un msg.
# 1 = exito.
# 0 = error.
sub insertFriendly {
    my ($friendly,$path,$code) = @_;
    # por defecto es friendly 200
    $code = $code || 200;
    my ($cmd);
    my ($pag,$vista);

    # Elimina posible(s) trailing slash(es).
    $friendly =~ s/(.+)\/$/$1/g;

    # Verifica si el friendly ya existe.
    my ($res,$data,$msg) = &readFriendly($friendly);
    # print STDERR "readfriendly ($res,$data,$msg)\n";

    # Si ya existe, lo elimina.
    if (($res == 1) || ($res == 2) || ($res == 3) || ($res == 4) || ($res == 6) || ($res == 7) || ($res == 8) ) {
        ($res,$msg) = &deleteFriendly($friendly);
        # print STDERR "deleteFriendly ($res,$data,$msg)\n";
    }elsif ($res == 9) {
        # Si no existe, marca borrado exitoso para poder seguir.
        $res = 0;
    }elsif ($res == 0) {
        # Si no existe, marca borrado exitoso para poder seguir.
        $res = 1;
    }

    # $friendly se pasa a minusculas para mantener consistencia
    $friendly = lc($friendly);
    if (($res == 1) || ($res == 2)) {
        # Si no hubo error, se puede insertar.

        # Elimina la vista del friendly, si estuviera.
        ($vista,$friendly) = &getVista($friendly);

        # Elimina la pagina del friendly, si estuviera.
        ($pag,$friendly) = &getPag($friendly);

        # Crea el MD5.
        my $md5 = Digest::MD5::md5_hex($friendly);
        # print STDERR "InsertFriendly [$md5]->[$friendly]\n";

        # Crea el path del symlink.
        my $dir = $F5DIR .'/'. substr($md5,0,2) .'/'. substr($md5,2,2);
        # se debe crear un redirect 302
        if ($code eq '302') {
            $dir = $F5DIR ."/$DIR302/". substr($md5,0,2) .'/'. substr($md5,2,2);
        }

        my $symlink = "$dir/$md5";
        print STDERR "f5 [url $friendly] link[$symlink]\n";
        if (!-d $dir) {
            $cmd = "mkdir -p $dir";
            system $cmd;
        }

        my $fullPath = "$ROOTDIR$path";
        $cmd = "ln -sr $fullPath $symlink 2>&1";
        $res = `$cmd`;
        $msg = "Friendly fue creado [$res]";
        $data = $path;
        $res = 1;
    }elsif ($res == 5) {
        # Se trata de un archivo fisico, el friendly no se puede hacer.
        $res = 0;
        $msg = 'URL corresponde a un path físico';
    }else{
        $res = 0;
        $msg = 'URL existe y no se pudo borrar';
    }

    return ($res,$data,$msg);

} # insertFriendly

#------------------------------------------------------------------------------#
# Elimina el link simbolico del friendly.
sub deleteFriendly {
    my $friendly = defined($_[0])? $_[0]:'';
    if ($friendly eq '') {
        return (2, 'Friendly no existe');
    }

    my ($msg,$res);
    my ($pag,$vista);

    # Elimina posible(s) trailing slash(es), "/" finales
    $friendly =~ s/(.+)\/$/$1/g;

    # Elimina la vista del friendly, si estuviera
    ($vista,$friendly) = &getVista($friendly);

    # Elimina la pagina del friendly, si estuviera
    ($pag,$friendly) = &getPag($friendly);

    # Crea el MD5.
    my $md5 = Digest::MD5::md5_hex($friendly);

    # Crea el path del symlink
    my $symlink = $F5DIR .'/'. substr($md5,0,2) .'/'. substr($md5,2,2) .'/'. $md5;
    # symlink 302
    my $symlink_302 = $F5DIR ."/$DIR302/". substr($md5,0,2) .'/'. substr($md5,2,2) .'/'. $md5;

    # Verifica si el symlink existe
    if (-l $symlink || -f $symlink) {
        if (unlink $symlink) {
            $res = 1;
            $msg = "Friendly fue eliminado";
        }else{
            $res = 0;
            $msg = "Friendly no pudo ser eliminado";
        }
    } elsif (-l $symlink_302) {
        if (unlink $symlink_302) {
            $res = 1;
            $msg = "Friendly fue eliminado";
        }else{
            $res = 0;
            $msg = "Friendly no pudo ser eliminado";
        }
    } elsif (-l "$prontus_varglb::DIR_SERVER$friendly/index.html") {
        if (unlink "$prontus_varglb::DIR_SERVER$friendly/index.html") {
            $res = 1;
            $msg = "Friendly fue eliminado";
        }else{
            $res = 0;
            $msg = "Friendly no pudo ser eliminado";
        }
    } elsif (-d $symlink) {
        $res = 2;
        $msg = 'Friendly no pudo ser eliminado, es directorio';
    } else {
        $res = 2;
        $msg = 'Friendly no existe';
    }

    return ($res,$msg);
} # deleteFriendly

#------------------------------------------------------------------------------#
# Detecta la pagina de un friendly. Retorna la pagina y el friendly sin pagina.
sub getPag {
    my $friendly = defined($_[0])? $_[0]:'';
    my ($pag,$prefix);
    $pag = ''; # Inicializa como string vacio.
    if ($friendly =~ /\/p\/(\d+)$/) {
        ($prefix,$pag) = ($`,$1);
        $friendly = $prefix;
    }elsif ($friendly =~ /\/p\/?$/) {
        ($prefix,$pag) = ($`,'');
        $friendly = $prefix;
    }
    return ($pag,$friendly);
} # getPag

#------------------------------------------------------------------------------#
# Compone un path insertando la pagina si corresponde.
sub insertPag {
    my ($pag,$path) = @_;
    my ($prefix,$ext);
    my $isPaged = 0;
    # Procesa si la pagina es un numero.
    if ($pag =~ /^\d+$/) {
        # Inserta la pagina si el path corresponde a un patron paginado.
        if ($path =~ /^(.+_)1(\.\w+)$/) {
            ($prefix,$ext) = ($1,$2);
            $path = $prefix . $pag . $ext;
            $isPaged = 1;
        }
    }
    return ($path,$isPaged);
} # insertPag

#------------------------------------------------------------------------------#
# Detecta la vista de un friendly. Retorna la vista y el friendly sin vista.
sub getVista {
    my $friendly = defined($_[0])? $_[0]:'';
    my ($prefix,$friendlySinVista) = ('', '');
    foreach my $vista (@VISTAS) {
        $prefix = $vista;
        if ($friendly =~ m|^/$prefix(/.+)|) {
            $friendlySinVista = $1;
            return ($vista,$friendlySinVista);
        }
    }
    return ('',$friendly);
} # getVista

#------------------------------------------------------------------------------#
# Compone un path insertando la vista si corresponde.
sub insertVista {
    my ($vista,$path) = @_;
    # Si se trata de la vista por defecto, no hace nada.
    if ($vista ne '') {
        # Antepone el guion de rigor.
        $vista = '-' . $vista;
        # Compara el path con cada patron de vista que existe.
        foreach my $vistaPat (@VISTAS_PATHS) {
            # ([\/\w\-]+\/site\/artic\/\d+\/pags)(\/[\w\.\-\/]+)
            # Si el patron coincide, inserta la vista.
            if ($path =~ /$vistaPat$/) {
                $path = $1 . $vista . $2;
                last;
            }
        }
    }
    return $path;
} # insertVista

1;
