tpl2tt2.pl.in 10.4 KB
Newer Older
salaun's avatar
salaun committed
1
#! --PERL--
2
# -*- indent-tabs-mode: nil; -*-
3
# vim:ft=perl:et:sw=4
4
# $Id$
salaun's avatar
salaun committed
5
6

# Sympa - SYsteme de Multi-Postage Automatique
7
8
9
10
#
# 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
11
# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
12
13
14
# 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>.
salaun's avatar
salaun committed
15
16
17
18
19
20
21
22
23
24
25
26
#
# 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
27
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
salaun's avatar
salaun committed
28

29
use lib '--modulesdir--';
30
31
use strict;
use warnings;
32
use English qw(-no_match_vars);
33

34
use Conf;
35
use Sympa::Constants;
sikeda's avatar
sikeda committed
36
use Sympa::DatabaseManager;
37
use Sympa::Language;
38
use Sympa::List;
39
use Sympa::Log;
40
use Sympa::Tools::File;
salaun's avatar
salaun committed
41
42
43

my %options;

44
$OUTPUT_AUTOFLUSH = 1;
salaun's avatar
salaun committed
45
46

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

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

salaun's avatar
salaun committed
56
## Load sympa config
57
unless (Conf::load()) {
salaun's avatar
salaun committed
58
59
60
    die 'config_error';
}

61
62
# Check database connectivity and probe database
#FIXME: Is it required?
sikeda's avatar
sikeda committed
63
unless (Sympa::DatabaseManager::probe_db()) {
64
65
66
    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'};
67
68
}

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

sikeda's avatar
sikeda committed
77
    convert($f);
78
79
80
81
82
83
84
85

    exit 0;
}

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

my @directories;
my @templates;
salaun's avatar
salaun committed
86
87

## Search in main robot
88
89
90
if (-d $Conf::Conf{'etc'}) {
    push @directories, $Conf::Conf{'etc'};
}
salaun's avatar
salaun committed
91
92
93
94
95
96
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";
}
97
98
99
if (-f "$Conf::Conf{'etc'}/mhonarc-ressources") {
    push @templates, "$Conf::Conf{'etc'}/mhonarc-ressources";
}
salaun's avatar
salaun committed
100

101
## Create_list_templates
102
if (-d $Conf::Conf{'etc'} . '/create_list_templates') {
103
    foreach my $dir (<$Conf::Conf{'etc'}/create_list_templates/*>) {
104
105
        next unless (-d $dir);
        push @directories, $dir;
106
107
108
    }
}

salaun's avatar
salaun committed
109
110
111
## Go through Virtual Robots
foreach my $vr (keys %{$Conf::Conf{'robots'}}) {
    ## Search in etc/
112
113
    if (-d "$Conf::Conf{'etc'}/$vr") {
        push @directories, "$Conf::Conf{'etc'}/$vr";
114
    }
115

salaun's avatar
salaun committed
116
    if (-d "$Conf::Conf{'etc'}/$vr/templates") {
117
        push @directories, "$Conf::Conf{'etc'}/$vr/templates";
salaun's avatar
salaun committed
118
119
    }
    if (-d "$Conf::Conf{'etc'}/$vr/wws_templates") {
120
        push @directories, "$Conf::Conf{'etc'}/$vr/wws_templates";
salaun's avatar
salaun committed
121
    }
122
    if (-f "$Conf::Conf{'etc'}/$vr/mhonarc-ressources") {
123
        push @templates, "$Conf::Conf{'etc'}/$vr/mhonarc-ressources";
124
    }
salaun's avatar
salaun committed
125

126
    ## Create_list_templates
127
128
129
130
131
    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;
        }
132
133
    }

salaun's avatar
salaun committed
134
    ## Search in V. Robot Lists
135
    my $listOfLists = Sympa::List::get_lists($vr);
136
137
138
139
140
141
142
143
144
145
    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";
        }
salaun's avatar
salaun committed
146
147
148
149
150
    }
}

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

salaun's avatar
salaun committed
152
    unless (opendir DIR, $d) {
153
        printf STDERR "Error: Cannot read %s directory : %s\n", $d, $ERRNO;
154
        next;
salaun's avatar
salaun committed
155
    }
156
157
158

    foreach my $tpl (sort grep(/\.tpl$/, readdir DIR)) {
        push @templates, "$d/$tpl";
salaun's avatar
salaun committed
159
    }
160

salaun's avatar
salaun committed
161
162
163
164
165
    closedir DIR;
}

my $total;
foreach my $tpl (@templates) {
166
167
168

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

salaun's avatar
salaun committed
175
    unless (-r $tpl) {
176
177
        printf STDERR "Error : Unable to read file %s\n", $tpl;
        next;
salaun's avatar
salaun committed
178
179
180
    }

    unless ($tpl =~ /^(.+)\/([^\/]+)$/) {
181
182
        printf STDERR "Error : Incorrect Path %s\n", $tpl;
        next;
salaun's avatar
salaun committed
183
    }
184

salaun's avatar
salaun committed
185
186
187
188
189
190
    my ($path, $file) = ($1, $2);
    my ($dest_path, $dest_file);

    ## Destinatination Path
    $dest_path = $path;
    if ($path =~ /\/wws_templates$/) {
191
192
193
194
195
196
197
198
199
        ## 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;
salaun's avatar
salaun committed
200
201
202
203
204
205
    }

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

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

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

salaun's avatar
salaun committed
218
219
    ## Create directory if required
    unless (-d $dest_path) {
220
221
        printf "Creating $dest_path directory\n";
        unless (my_mkdir($dest_path)) {
222
223
            printf STDERR "Error : Cannot create %s directory: %s\n",
                $dest_path, $ERRNO;
224
225
226
            next;
        }
        unless (
227
            Sympa::Tools::File::set_file_rights(
228
229
230
231
232
                file  => $dest_path,
                user  => Sympa::Constants::USER,
                group => Sympa::Constants::GROUP,
                mode  => 0755,
            )
Luc Didry's avatar
Luc Didry committed
233
        ) {
234
            $log->syslog('err', 'Unable to set rights on %s',
235
236
237
                $Conf::Conf{'db_name'});
            next;
        }
salaun's avatar
salaun committed
238
239
240
241
    }

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

sikeda's avatar
sikeda committed
242
    convert($tpl, $tt2);
salaun's avatar
salaun committed
243
    $total++;
244

salaun's avatar
salaun committed
245
246
    ## Rename old files to .converted
    unless (rename $tpl, "$tpl.converted") {
247
248
        printf STDERR "Error : failed to rename %s to %s.converted: %s\n",
            $tpl, $tpl, $ERRNO;
249
        next;
salaun's avatar
salaun committed
250
251
252
253
    }
}

print "\n$total template files have been converted\n";
254
255
256
257
258
259
260

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

    ## Convert tpl file
    unless (open TPL, $in_file) {
261
        print STDERR "Cannot open $in_file : $ERRNO\n";
262
        return undef;
263
264
    }
    if ($out_file) {
265
        unless (open TT2, ">$out_file") {
266
            print STDERR "Cannot create $out_file : $ERRNO\n";
267
268
            return undef;
        }
269
270
271
    }

    while (<TPL>) {
272
        if ($out_file) {
273
            print TT2 _translate($_);
274
        } else {
275
            print STDOUT _translate($_);
276
        }
277
278
279
280
    }
    close TT2 if ($out_file);
    close TPL;

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

    unless (
284
        Sympa::Tools::File::set_file_rights(
285
286
287
288
            file  => $out_file,
            user  => Sympa::Constants::USER,
            group => Sympa::Constants::GROUP
        )
Luc Didry's avatar
Luc Didry committed
289
    ) {
290
        $log->syslog('err', 'Unable to set rights on %s',
291
292
            $Conf::Conf{'db_name'});
        return undef;
293
    }
294
}
295
296
297
298
299
300
301

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

    unless ($path) {
302
        return undef;
303
304
305
    }

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

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

        unless (mkdir($path, 0777)) {
317
318
            printf STDERR "Error : Cannot create directory %s: %s\n", $path,
                $ERRNO;
319
320
321
322
323
324
            return undef;
        }
    } else {
        return undef;
    }

325
326
    return 1;
}
327

328
329
# Old name: Sympa::Template::Compat::_translate() which was originally a part
# of tt2.pm.
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
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;

    $_;
}