tpl2tt2.pl.in

#! --PERL--
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$

# Sympa - SYsteme de Multi-Postage Automatique
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
# Copyright 2021 The Sympa Community. See the
# AUTHORS.md file at the top-level directory of this distribution and at
# <https://github.com/sympa-community/sympa.git>.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

use lib '--modulesdir--';
use strict;
use warnings;
use English qw(-no_match_vars);

use Conf;
use Sympa::Constants;
use Sympa::DatabaseManager;
use Sympa::Language;
use Sympa::List;
use Sympa::Log;
use Sympa::Tools::File;

my %options;

$OUTPUT_AUTOFLUSH = 1;

## Check UID
#unless (getlogin() eq Sympa::Constants::USER) {
#    print "You should run this script as user \"sympa\", ignore ? (y/CR)";
#    my $s = <STDIN>;
#    die unless ($s =~ /^y$/i);
#}

# FIXME: Is logging required?
my $log = Sympa::Log->instance;

## Load sympa config
unless (Conf::load()) {
    die 'config_error';
}

# Check database connectivity and probe database
#FIXME: Is it required?
unless (Sympa::DatabaseManager::probe_db()) {
    die sprintf
        "Database %s defined in sympa.conf has not the right structure or is unreachable. verify db_xxx parameters in sympa.conf\n",
        $Conf::Conf{'db_name'};
}

## We have a parameter that should be a template to convert
## Output is sent to stdout
if ($#ARGV >= 0) {
    my $f = $ARGV[0];
    unless (-f $f) {
        die "unable to find file $f";
    }

    convert($f);

    exit 0;
}

## Default is to migrate every template to the new TT2 format

my @directories;
my @templates;

## Search in main robot
if (-d $Conf::Conf{'etc'}) {
    push @directories, $Conf::Conf{'etc'};
}
if (-d "$Conf::Conf{'etc'}/templates") {
    push @directories, "$Conf::Conf{'etc'}/templates";
}
if (-d "$Conf::Conf{'etc'}/wws_templates") {
    push @directories, "$Conf::Conf{'etc'}/wws_templates";
}
if (-f "$Conf::Conf{'etc'}/mhonarc-ressources") {
    push @templates, "$Conf::Conf{'etc'}/mhonarc-ressources";
}

## Create_list_templates
if (-d $Conf::Conf{'etc'} . '/create_list_templates') {
    foreach my $dir (<$Conf::Conf{'etc'}/create_list_templates/*>) {
        next unless (-d $dir);
        push @directories, $dir;
    }
}

## Go through Virtual Robots
foreach my $vr (keys %{$Conf::Conf{'robots'}}) {
    ## Search in etc/
    if (-d "$Conf::Conf{'etc'}/$vr") {
        push @directories, "$Conf::Conf{'etc'}/$vr";
    }

    if (-d "$Conf::Conf{'etc'}/$vr/templates") {
        push @directories, "$Conf::Conf{'etc'}/$vr/templates";
    }
    if (-d "$Conf::Conf{'etc'}/$vr/wws_templates") {
        push @directories, "$Conf::Conf{'etc'}/$vr/wws_templates";
    }
    if (-f "$Conf::Conf{'etc'}/$vr/mhonarc-ressources") {
        push @templates, "$Conf::Conf{'etc'}/$vr/mhonarc-ressources";
    }

    ## Create_list_templates
    if (-d $Conf::Conf{'etc'} . '/' . $vr . '/create_list_templates') {
        foreach my $dir (<$Conf::Conf{'etc'}/$vr/create_list_templates/*>) {
            next unless (-d $dir);
            push @directories, $dir;
        }
    }

    ## Search in V. Robot Lists
    my $listOfLists = Sympa::List::get_lists($vr);
    foreach my $list (@$listOfLists) {

        push @directories, $list->{'dir'};

        if (-d "$list->{'dir'}/templates") {
            push @directories, "$list->{'dir'}/templates";
        }
        if (-d "$list->{'dir'}/wws_templates") {
            push @directories, "$list->{'dir'}/wws_templates";
        }
    }
}

## List .tpl files
foreach my $d (@directories) {

    unless (opendir DIR, $d) {
        printf STDERR "Error: Cannot read %s directory : %s\n", $d, $ERRNO;
        next;
    }

    foreach my $tpl (sort grep(/\.tpl$/, readdir DIR)) {
        push @templates, "$d/$tpl";
    }

    closedir DIR;
}

my $total;
foreach my $tpl (@templates) {

    ## We don't migrate mhonarc-ressources files
    if ($tpl =~ /mhonarc\-ressources$/) {
        rename $tpl, "$tpl.incompatible";
        printf STDERR
            "File $tpl could not be translated to TT2 ; it has been renamed $tpl.incompatible. You should customize a standard mhonarc_rc.tt2 file\n";
        next;
    }

    unless (-r $tpl) {
        printf STDERR "Error : Unable to read file %s\n", $tpl;
        next;
    }

    unless ($tpl =~ /^(.+)\/([^\/]+)$/) {
        printf STDERR "Error : Incorrect Path %s\n", $tpl;
        next;
    }

    my ($path, $file) = ($1, $2);
    my ($dest_path, $dest_file);

    ## Destinatination Path
    $dest_path = $path;
    if ($path =~ /\/wws_templates$/) {
        ## translated web templates should not be used because they
        ## will not fit the new CSS/XHTML web structure
        $dest_path =~ s/wws_templates/web_tt2.old/;
    } elsif ($path =~ /\/templates$/) {
        $dest_path =~ s/templates/mail_tt2/;
    } elsif ($path =~ /\/expl\//) {
        $dest_path .= '/mail_tt2';
    } else {
        $dest_path = $path;
    }

    ## Destination filename
    $dest_file = $file;
    $dest_file =~ s/\.tpl$/\.tt2/;

    ## Localized template
    if ($dest_file =~ /^([\w\-]+)\.(\w+)\.tt2$/) {
        my $lang = $2;
        $dest_file =~ s/^([\w\-]+)\.(\w+)\.tt2$/$1\.tt2/;
        $dest_path .= '/' . Sympa::Language::lang2oldlocale($lang);
    }

    ## If file has no extension
    unless ($dest_file =~ /\./) {
        $dest_file = $file . '.tt2';
    }

    ## Create directory if required
    unless (-d $dest_path) {
        printf "Creating $dest_path directory\n";
        unless (my_mkdir($dest_path)) {
            printf STDERR "Error : Cannot create %s directory: %s\n",
                $dest_path, $ERRNO;
            next;
        }
        unless (
            Sympa::Tools::File::set_file_rights(
                file  => $dest_path,
                user  => Sympa::Constants::USER,
                group => Sympa::Constants::GROUP,
                mode  => 0755,
            )
        ) {
            $log->syslog('err', 'Unable to set rights on %s',
                $Conf::Conf{'db_name'});
            next;
        }
    }

    my $tt2 = "$dest_path/$dest_file";

    convert($tpl, $tt2);
    $total++;

    ## Rename old files to .converted
    unless (rename $tpl, "$tpl.converted") {
        printf STDERR "Error : failed to rename %s to %s.converted: %s\n",
            $tpl, $tpl, $ERRNO;
        next;
    }
}

print "\n$total template files have been converted\n";

## Convert a template file to tt2
sub convert {
    my ($in_file, $out_file) = @_;

    ## Convert tpl file
    unless (open TPL, $in_file) {
        print STDERR "Cannot open $in_file : $ERRNO\n";
        return undef;
    }
    if ($out_file) {
        unless (open TT2, ">$out_file") {
            print STDERR "Cannot create $out_file : $ERRNO\n";
            return undef;
        }
    }

    while (<TPL>) {
        if ($out_file) {
            print TT2 _translate($_);
        } else {
            print STDOUT _translate($_);
        }
    }
    close TT2 if ($out_file);
    close TPL;

    printf "Template file $in_file has been converted to $out_file\n";

    unless (
        Sympa::Tools::File::set_file_rights(
            file  => $out_file,
            user  => Sympa::Constants::USER,
            group => Sympa::Constants::GROUP
        )
    ) {
        $log->syslog('err', 'Unable to set rights on %s',
            $Conf::Conf{'db_name'});
        return undef;
    }
}

## Create root folders if required
sub my_mkdir {
    my $path = shift;
    $path =~ s/\/$//;

    unless ($path) {
        return undef;
    }

    if ($path =~ /^(.*)\/[^\/]+$/) {
        my $root_path = $1;

        unless (-d $root_path) {
            unless (mkdir($root_path, 0777)) {
                printf STDERR "Error : Cannot create directory %s: %s\n",
                    $root_path, $ERRNO;
                return undef;
            }
        }

        unless (mkdir($path, 0777)) {
            printf STDERR "Error : Cannot create directory %s: %s\n", $path,
                $ERRNO;
            return undef;
        }
    } else {
        return undef;
    }

    return 1;
}

# Old name: Sympa::Template::Compat::_translate() which was originally a part
# of tt2.pm.
sub _translate {
    local $_ = join('', @_);

    # if / endif
    s/\[\s*(ELSIF|IF)\s+(.*?)\s*=\s*(.*?)\s*\]/[% \U$1\E $2 == '$3' %]/ig;
    s/\[\s*(ELSIF|IF)\s+(.*?)\s*<>\s*(.*?)\s*\]/[% \U$1\E $2 != '$3' %]/ig;
    s/\[\s*(ELSIF|IF)\s+(.*?)\s*\]/[% \U$1\E $2 %]/ig;
    s/\[\s*ELSE\s*\]/[% ELSE %]/ig;
    s/\[\s*ENDIF\s*\]/[% END %]/ig;

    # parse -> process
    s/\[\s*PARSE\s*('.*?')\s*\]/[% PROCESS $1 %]/ig;
    s/\[\s*PARSE\s*(.*?)\]/[% PROCESS \$$1 IF $1 %]/ig;

    # variable access
    while (s/\[(.*?)([^\]-]+?)->(\d+)(.*)\]/[$1$2.item('$3')$4]/g) { }
    while (s/\[(.*?)([^\]-]+?)->(\w+)(.*)\]/[$1$2.$3$4]/g)         { }
    s/\[\s*SET\s+(\w+)=(.*?)\s*\]/[% SET $1 = $2 %]/ig;

    # foreach
    s/\[\s*FOREACH\s*(\w+)\s*IN\s*([\w.()\'\/]+)\s*\]/[% FOREACH $1 = $2 %]
    [% SET tmp = $1.key $1 = $1.value $1.NAME = tmp IF $1.key.defined %]/ig;
    s/\[\s*END\s*\]/[% END %]/ig;

    # sanity check before including file
    s/\[\s*INCLUDE\s*('.*?')\s*\]/[% INSERT $1 %]/ig;
    s/\[\s*INCLUDE\s*(\w+?)\s*\]/[% INSERT \$$1 IF $1 %]/ig;

    ## Be careful to absolute path
    if (/\[%\s*(PROCESS|INSERT)\s*\'(\S+)\'\s*%\]/) {
        my $file     = $2;
        my $new_file = $file;
        $new_file =~ s/\.tpl$/\.tt2/;
        my @path = split /\//, $new_file;
        $new_file = $path[$#path];
        s/\'$file\'/\'$new_file\'/;
    }

    # setoption
    s/\[\s*SETOPTION\s(escape_)?html.*?\]/[% FILTER html_entity %]/ig;
    s/\[\s*SETOPTION\signore_undef.*?\]/[% IF 1 %]/ig;
    s/\[\s*UNSETOPTION.*?\]/[% END %]/ig;

    s/\[\s*([\w.()\'\/]+)\s*\]/[% $1 %]/g;

    s/\[\s*(STOP|START)PARSE\s*\]//ig;

    $_;
}