1#! --PERL--
2# -*- indent-tabs-mode: nil; -*-
3# vim:ft=perl:et:sw=4
4# $Id$
5
6# Sympa - SYsteme de Multi-Postage Automatique
7#
8# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
9# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
10# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
11# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
12#
13# This program is free software; you can redistribute it and/or modify
14# it under the terms of the GNU General Public License as published by
15# the Free Software Foundation; either version 2 of the License, or
16# (at your option) any later version.
17#
18# This program is distributed in the hope that it will be useful,
19# but WITHOUT ANY WARRANTY; without even the implied warranty of
20# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
21# GNU General Public License for more details.
22#
23# You should have received a copy of the GNU General Public License
24# along with this program.  If not, see <http://www.gnu.org/licenses/>.
25
26use lib '--modulesdir--';
27use strict;
28use warnings;
29use English qw(-no_match_vars);
30
31use Conf;
32use Sympa::Constants;
33use Sympa::DatabaseManager;
34use Sympa::Language;
35use Sympa::List;
36use Sympa::Log;
37use Sympa::Tools::File;
38
39my %options;
40
41$OUTPUT_AUTOFLUSH = 1;
42
43## Check UID
44#unless (getlogin() eq Sympa::Constants::USER) {
45#    print "You should run this script as user \"sympa\", ignore ? (y/CR)";
46#    my $s = <STDIN>;
47#    die unless ($s =~ /^y$/i);
48#}
49
50# FIXME: Is logging required?
51my $log = Sympa::Log->instance;
52
53## Load sympa config
54unless (Conf::load()) {
55    die 'config_error';
56}
57
58# Check database connectivity and probe database
59#FIXME: Is it required?
60unless (Sympa::DatabaseManager::probe_db()) {
61    die sprintf
62        "Database %s defined in sympa.conf has not the right structure or is unreachable. verify db_xxx parameters in sympa.conf\n",
63        $Conf::Conf{'db_name'};
64}
65
66## We have a parameter that should be a template to convert
67## Output is sent to stdout
68if ($#ARGV >= 0) {
69    my $f = $ARGV[0];
70    unless (-f $f) {
71        die "unable to find file $f";
72    }
73
74    convert($f);
75
76    exit 0;
77}
78
79## Default is to migrate every template to the new TT2 format
80
81my @directories;
82my @templates;
83
84## Search in main robot
85if (-d $Conf::Conf{'etc'}) {
86    push @directories, $Conf::Conf{'etc'};
87}
88if (-d "$Conf::Conf{'etc'}/templates") {
89    push @directories, "$Conf::Conf{'etc'}/templates";
90}
91if (-d "$Conf::Conf{'etc'}/wws_templates") {
92    push @directories, "$Conf::Conf{'etc'}/wws_templates";
93}
94if (-f "$Conf::Conf{'etc'}/mhonarc-ressources") {
95    push @templates, "$Conf::Conf{'etc'}/mhonarc-ressources";
96}
97
98## Create_list_templates
99if (-d $Conf::Conf{'etc'} . '/create_list_templates') {
100    foreach my $dir (<$Conf::Conf{'etc'}/create_list_templates/*>) {
101        next unless (-d $dir);
102        push @directories, $dir;
103    }
104}
105
106## Go through Virtual Robots
107foreach my $vr (keys %{$Conf::Conf{'robots'}}) {
108    ## Search in etc/
109    if (-d "$Conf::Conf{'etc'}/$vr") {
110        push @directories, "$Conf::Conf{'etc'}/$vr";
111    }
112
113    if (-d "$Conf::Conf{'etc'}/$vr/templates") {
114        push @directories, "$Conf::Conf{'etc'}/$vr/templates";
115    }
116    if (-d "$Conf::Conf{'etc'}/$vr/wws_templates") {
117        push @directories, "$Conf::Conf{'etc'}/$vr/wws_templates";
118    }
119    if (-f "$Conf::Conf{'etc'}/$vr/mhonarc-ressources") {
120        push @templates, "$Conf::Conf{'etc'}/$vr/mhonarc-ressources";
121    }
122
123    ## Create_list_templates
124    if (-d $Conf::Conf{'etc'} . '/' . $vr . '/create_list_templates') {
125        foreach my $dir (<$Conf::Conf{'etc'}/$vr/create_list_templates/*>) {
126            next unless (-d $dir);
127            push @directories, $dir;
128        }
129    }
130
131    ## Search in V. Robot Lists
132    my $listOfLists = Sympa::List::get_lists($vr);
133    foreach my $list (@$listOfLists) {
134
135        push @directories, $list->{'dir'};
136
137        if (-d "$list->{'dir'}/templates") {
138            push @directories, "$list->{'dir'}/templates";
139        }
140        if (-d "$list->{'dir'}/wws_templates") {
141            push @directories, "$list->{'dir'}/wws_templates";
142        }
143    }
144}
145
146## List .tpl files
147foreach my $d (@directories) {
148
149    unless (opendir DIR, $d) {
150        printf STDERR "Error: Cannot read %s directory : %s\n", $d, $ERRNO;
151        next;
152    }
153
154    foreach my $tpl (sort grep(/\.tpl$/, readdir DIR)) {
155        push @templates, "$d/$tpl";
156    }
157
158    closedir DIR;
159}
160
161my $total;
162foreach my $tpl (@templates) {
163
164    ## We don't migrate mhonarc-ressources files
165    if ($tpl =~ /mhonarc\-ressources$/) {
166        rename $tpl, "$tpl.incompatible";
167        printf STDERR
168            "File $tpl could not be translated to TT2 ; it has been renamed $tpl.incompatible. You should customize a standard mhonarc_rc.tt2 file\n";
169        next;
170    }
171
172    unless (-r $tpl) {
173        printf STDERR "Error : Unable to read file %s\n", $tpl;
174        next;
175    }
176
177    unless ($tpl =~ /^(.+)\/([^\/]+)$/) {
178        printf STDERR "Error : Incorrect Path %s\n", $tpl;
179        next;
180    }
181
182    my ($path, $file) = ($1, $2);
183    my ($dest_path, $dest_file);
184
185    ## Destinatination Path
186    $dest_path = $path;
187    if ($path =~ /\/wws_templates$/) {
188        ## translated web templates should not be used because they
189        ## will not fit the new CSS/XHTML web structure
190        $dest_path =~ s/wws_templates/web_tt2.old/;
191    } elsif ($path =~ /\/templates$/) {
192        $dest_path =~ s/templates/mail_tt2/;
193    } elsif ($path =~ /\/expl\//) {
194        $dest_path .= '/mail_tt2';
195    } else {
196        $dest_path = $path;
197    }
198
199    ## Destination filename
200    $dest_file = $file;
201    $dest_file =~ s/\.tpl$/\.tt2/;
202
203    ## Localized template
204    if ($dest_file =~ /^([\w\-]+)\.(\w+)\.tt2$/) {
205        my $lang = $2;
206        $dest_file =~ s/^([\w\-]+)\.(\w+)\.tt2$/$1\.tt2/;
207        $dest_path .= '/' . Sympa::Language::lang2oldlocale($lang);
208    }
209
210    ## If file has no extension
211    unless ($dest_file =~ /\./) {
212        $dest_file = $file . '.tt2';
213    }
214
215    ## Create directory if required
216    unless (-d $dest_path) {
217        printf "Creating $dest_path directory\n";
218        unless (my_mkdir($dest_path)) {
219            printf STDERR "Error : Cannot create %s directory: %s\n",
220                $dest_path, $ERRNO;
221            next;
222        }
223        unless (
224            Sympa::Tools::File::set_file_rights(
225                file  => $dest_path,
226                user  => Sympa::Constants::USER,
227                group => Sympa::Constants::GROUP,
228                mode  => 0755,
229            )
230        ) {
231            $log->syslog('err', 'Unable to set rights on %s',
232                $Conf::Conf{'db_name'});
233            next;
234        }
235    }
236
237    my $tt2 = "$dest_path/$dest_file";
238
239    convert($tpl, $tt2);
240    $total++;
241
242    ## Rename old files to .converted
243    unless (rename $tpl, "$tpl.converted") {
244        printf STDERR "Error : failed to rename %s to %s.converted: %s\n",
245            $tpl, $tpl, $ERRNO;
246        next;
247    }
248}
249
250print "\n$total template files have been converted\n";
251
252## Convert a template file to tt2
253sub convert {
254    my ($in_file, $out_file) = @_;
255
256    ## Convert tpl file
257    unless (open TPL, $in_file) {
258        print STDERR "Cannot open $in_file : $ERRNO\n";
259        return undef;
260    }
261    if ($out_file) {
262        unless (open TT2, ">$out_file") {
263            print STDERR "Cannot create $out_file : $ERRNO\n";
264            return undef;
265        }
266    }
267
268    while (<TPL>) {
269        if ($out_file) {
270            print TT2 _translate($_);
271        } else {
272            print STDOUT _translate($_);
273        }
274    }
275    close TT2 if ($out_file);
276    close TPL;
277
278    printf "Template file $in_file has been converted to $out_file\n";
279
280    unless (
281        Sympa::Tools::File::set_file_rights(
282            file  => $out_file,
283            user  => Sympa::Constants::USER,
284            group => Sympa::Constants::GROUP
285        )
286    ) {
287        $log->syslog('err', 'Unable to set rights on %s',
288            $Conf::Conf{'db_name'});
289        return undef;
290    }
291}
292
293## Create root folders if required
294sub my_mkdir {
295    my $path = shift;
296    $path =~ s/\/$//;
297
298    unless ($path) {
299        return undef;
300    }
301
302    if ($path =~ /^(.*)\/[^\/]+$/) {
303        my $root_path = $1;
304
305        unless (-d $root_path) {
306            unless (mkdir($root_path, 0777)) {
307                printf STDERR "Error : Cannot create directory %s: %s\n",
308                    $root_path, $ERRNO;
309                return undef;
310            }
311        }
312
313        unless (mkdir($path, 0777)) {
314            printf STDERR "Error : Cannot create directory %s: %s\n", $path,
315                $ERRNO;
316            return undef;
317        }
318    } else {
319        return undef;
320    }
321
322    return 1;
323}
324
325# Old name: Sympa::Template::Compat::_translate() which was originally a part
326# of tt2.pm.
327sub _translate {
328    local $_ = join('', @_);
329
330    # if / endif
331    s/\[\s*(ELSIF|IF)\s+(.*?)\s*=\s*(.*?)\s*\]/[% \U$1\E $2 == '$3' %]/ig;
332    s/\[\s*(ELSIF|IF)\s+(.*?)\s*<>\s*(.*?)\s*\]/[% \U$1\E $2 != '$3' %]/ig;
333    s/\[\s*(ELSIF|IF)\s+(.*?)\s*\]/[% \U$1\E $2 %]/ig;
334    s/\[\s*ELSE\s*\]/[% ELSE %]/ig;
335    s/\[\s*ENDIF\s*\]/[% END %]/ig;
336
337    # parse -> process
338    s/\[\s*PARSE\s*('.*?')\s*\]/[% PROCESS $1 %]/ig;
339    s/\[\s*PARSE\s*(.*?)\]/[% PROCESS \$$1 IF $1 %]/ig;
340
341    # variable access
342    while (s/\[(.*?)([^\]-]+?)->(\d+)(.*)\]/[$1$2.item('$3')$4]/g) { }
343    while (s/\[(.*?)([^\]-]+?)->(\w+)(.*)\]/[$1$2.$3$4]/g)         { }
344    s/\[\s*SET\s+(\w+)=(.*?)\s*\]/[% SET $1 = $2 %]/ig;
345
346    # foreach
347    s/\[\s*FOREACH\s*(\w+)\s*IN\s*([\w.()\'\/]+)\s*\]/[% FOREACH $1 = $2 %]
348    [% SET tmp = $1.key $1 = $1.value $1.NAME = tmp IF $1.key.defined %]/ig;
349    s/\[\s*END\s*\]/[% END %]/ig;
350
351    # sanity check before including file
352    s/\[\s*INCLUDE\s*('.*?')\s*\]/[% INSERT $1 %]/ig;
353    s/\[\s*INCLUDE\s*(\w+?)\s*\]/[% INSERT \$$1 IF $1 %]/ig;
354
355    ## Be careful to absolute path
356    if (/\[%\s*(PROCESS|INSERT)\s*\'(\S+)\'\s*%\]/) {
357        my $file     = $2;
358        my $new_file = $file;
359        $new_file =~ s/\.tpl$/\.tt2/;
360        my @path = split /\//, $new_file;
361        $new_file = $path[$#path];
362        s/\'$file\'/\'$new_file\'/;
363    }
364
365    # setoption
366    s/\[\s*SETOPTION\s(escape_)?html.*?\]/[% FILTER html_entity %]/ig;
367    s/\[\s*SETOPTION\signore_undef.*?\]/[% IF 1 %]/ig;
368    s/\[\s*UNSETOPTION.*?\]/[% END %]/ig;
369
370    s/\[\s*([\w.()\'\/]+)\s*\]/[% $1 %]/g;
371
372    s/\[\s*(STOP|START)PARSE\s*\]//ig;
373
374    $_;
375}
376