Make tools mode 775
[claws.git] / tools / filter_conv_new.pl
1 #!/usr/bin/perl -w
2
3 use strict;
4 use XML::SimpleObject;
5
6 #  * This file is free software; you can redistribute it and/or modify it
7 #  * under the terms of the GNU General Public License as published by
8 #  * the Free Software Foundation; either version 3 of the License, or
9 #  * (at your option) any later version.
10 #  *
11 #  * This program is distributed in the hope that it will be useful, but
12 #  * WITHOUT ANY WARRANTY; without even the implied warranty of
13 #  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
14 #  * General Public License for more details.
15 #  *
16 #  * You should have received a copy of the GNU General Public License
17 #  * along with this program; if not, write to the Free Software
18 #  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
19 #  *
20 #  * Copyright 2006 Paul Mangan <paul@claws-mail.org>
21 #  *
22
23 #
24 # Convert new style Sylpheed filter rules (Sylpheed >= 0.9.99) to
25 # Claws Mail filtering rules
26 #
27
28 #
29 # TABLE OF EQUIVALENTS
30 #
31 # SYLPHEED                      :       Claws Mail
32 #------------------------------------------------------
33 #
34 # NAME
35 #
36 # name                          :       rulename
37 #
38 # CONDITION LIST
39 #
40 # bool or                       :       |
41 # bool and                      :       &
42 #
43 # match-header (name From)      :       from
44 # match-header (name To)        :       to
45 # match-header (name Cc)        :       cc
46 # match-header (name Subject)   :       subject
47 #       else...
48 # match-header                  :       header
49 #
50 # match-header (type contains)  :       [nothing]
51 # match-header (type not-contain) :     [append with ~]
52 # match-header (type is)        :       [no equivalent] (use type contains)
53 # match-header (type is-not)    :       [no equivalent] (use type not-contain)
54 # match-header (type regex)     :       regexpcase
55 # match-header (type not-regex) :       regexpcase [append with ~]
56 #
57 # matcher-any-header            ;       headers-part
58 # match-to-or-cc                :       to_or_cc
59 # match-body-text               :       body_part
60 # command-test                  :       test
61 # size  (type gt)               :       size_greater
62 # size (type lt)                :       size_smaller
63 # age (type gt)                 :       age_greater
64 # age (type lt)                 :       age_lower       
65 #
66 # ACTION LIST
67 #
68 # move                          :       move
69 # copy                          :       copy
70 # not-receive                   :       [no equivalent] (use type delete)
71 # delete                        :       delete
72 # mark                          :       mark
73 # color-label                   :       color
74 # mark-as-read                  :       mark_as_read
75 # exec                          :       execute
76 # stop-eval                     :       stop
77 #
78
79 my $old_config = "$ENV{HOME}/.sylpheed-2.0/filter.xml";
80 my $older_config = "$ENV{HOME}/.sylpheed/filter.xml";
81 my $old_filters;
82
83 my $config_dir = `claws-mail --config-dir` or die("ERROR:
84         You don't appear to have Claws Mail installed\n");
85 chomp $config_dir;
86
87 chdir($ENV{HOME} . "/$config_dir") or die("ERROR:
88         Claws Mail config directory not found [~/$config_dir]
89         You need to run Claws Mail once, quit it, and then rerun this script\n");
90
91 if (-e $old_config) {
92         $old_filters = $old_config;
93 } elsif (-e $older_config) {
94         $old_filters = $older_config;
95 } else {
96         print "ERROR:\n\tSylpheed filter not found\n\t[$old_config]\n\t[$older_config]\n";
97         exit;
98 }
99
100 my $claws_version = `claws-mail --version`;
101 $claws_version =~ s/^Claws Mail version //;
102
103 my ($major, $minor) = split(/\./, $claws_version);
104
105 my $version_test = 0;
106 if ($major > 2 || ($major == 2 && $minor >= 3)) {
107         $version_test = 1;
108 }
109
110 my $parser = XML::Parser->new(ErrorContext => 2, Style => "Tree");
111 my $xmlobj = XML::SimpleObject->new($parser->parsefile($old_filters));
112
113 my @conditions = ('match-header','match-to-or-cc','match-any-header',
114                   'match-body-text','command-test','size','age');
115
116 my @actions = ('copy','not-receive','mark','color-label','mark-as-read',
117                'exec','stop-eval','move','delete');
118
119 my $standard_headers = qr/^(?:Subject|From|To|Cc)$/;
120 my $negative_matches = qr/^(?:not-contain|is-not|not-regex)$/;
121 my $numeric_matches = qr/^(?:size|age)$/;
122 my $exact_matches = qr/^(?:move|copy|delete|mark)$/;
123
124 my @new_filters = ("[filtering]");
125
126 my $disabled = 0;
127 my $bool;
128
129 ## rules list
130 foreach my $element ($xmlobj->child("filter")->children("rule")) {
131         my $new_filter = "\n";
132         if ($element->attribute("enabled")) {
133                 if ($element->attribute("enabled") eq "false") {
134                         if ($version_test) {
135                                 $new_filter .= "disabled ";
136                         } else {
137                                 $disabled++;
138                                 next;   # skip disabled rules
139                         }
140                 } elsif ($version_test) {
141                                 $new_filter .= "enabled ";
142                 }
143         }
144         if ($element->attribute("name")) {
145                 my $name = $element->attribute("name");
146                 $name = clean_me($name);
147                 $new_filter .= "rulename \"$name\" ";
148         }
149 ## condition list
150         foreach my $parent ($element->children("condition-list")) {
151                 if ($parent->attribute("bool")) {
152                         $bool = $parent->attribute("bool");
153                         $bool =~ s/or/|/;
154                         $bool =~ s/and/&/;
155                 }
156                 foreach my $condition (@conditions) {
157                         my $new_condition = 0;
158                         my $type;
159                         if ($parent->children("$condition")) {
160                                 foreach my $sibling ($parent->children("$condition")) {
161                                         if ($new_condition) {
162                                                 $new_filter .= " $bool ";
163                                         }
164                                         if ($sibling->attribute("type")) {
165                                                 $type = $sibling->attribute("type");
166                                                 if ($type =~ m/$negative_matches/) {
167                                                         $new_filter .= '~';
168                                                 }
169                                         }
170                                         if ($sibling->attribute("name")) {
171                                                 my $name = $sibling->attribute("name");
172                                                 if ($condition eq "match-header") {
173                                                         if ($name =~ m/$standard_headers/) {
174                                                                 $new_filter .= lc($name) . " ";
175                                                         } else {
176                                                                 $new_filter .= "header \"$name\" ";
177                                                         }
178                                                 }
179                                         }
180                                         if ($condition eq "match-any-header") {
181                                                 $new_filter .= "headers_part ";
182                                         } elsif ($condition eq "match-to-or-cc") {
183                                                 $new_filter .= "to_or_cc ";
184                                         } elsif ($condition eq "match-body-text") {
185                                                 $new_filter .= "body_part ";
186                                         } elsif ($condition eq "command-test") {
187                                                 $new_filter .= "test ";
188                                         } elsif ($condition eq "size") {
189                                                 if ($type eq "gt") {
190                                                         $new_filter .= "size_greater ";
191                                                 } else {
192                                                         $new_filter .= "size_smaller ";
193                                                 }
194                                         } elsif ($condition eq "age") {
195                                                 if ($type eq "gt") {
196                                                         $new_filter .= "age_greater ";
197                                                 } else {
198                                                         $new_filter .= "age_lower ";
199                                                 }
200                                         }
201                                         if ($condition !~ m/$numeric_matches/ &&
202                                             $condition ne "command-test") {
203                                                 if ($type =~ m/regex/) {
204                                                         $new_filter .= "regexpcase ";
205                                                 } else {
206                                                         $new_filter .= "matchcase ";
207                                                 }
208                                         }
209                                         my $value = clean_me($sibling->value);
210                                         if ($condition =~ m/$numeric_matches/) {
211                                                 $new_filter .= "$value";
212                                         } else {
213                                                 $new_filter .= "\"$value\"";
214                                         }
215                                         $new_condition++;
216                                 }
217                         }
218                 }
219         }
220 ## end of condition list
221 ## action list
222         foreach my $parent ($element->children("action-list")) {
223                 foreach my $action (@actions) {
224                         if ($parent->children("$action")) {
225                                 foreach my $sibling ($parent->children("$action")) {
226                                         if ($action  =~ m/$exact_matches/) {
227                                                 $new_filter .= " $action";
228                                         } elsif ($action eq "not-receive") {
229                                                 $new_filter .= " delete";
230                                         } elsif ($action eq "color-label") {
231                                                 $new_filter .= " color";
232                                         } elsif ($action eq "mark-as-read") {
233                                                 $new_filter .= " mark_as_read";
234                                         } elsif ($action eq "exec") {
235                                                 $new_filter .= " execute";
236                                         } elsif ($action eq "stop-eval") {
237                                                 $new_filter .= " stop";
238                                         }
239                                         if ($sibling->value) {
240                                                 my $value = clean_me($sibling->value);
241                                                 if ($action eq "color-label") {
242                                                         $new_filter .= " $value";
243                                                 } else {
244                                                         $new_filter .= " \"$value\"";
245                                                 }
246                                         }
247                                 }
248                         }
249                 }
250         }
251 ## end of action list
252         push(@new_filters, $new_filter) if (defined($new_filter));
253 }
254 ## end of rules list
255 push(@new_filters, "\n");
256
257 # write new config
258 open(MATCHERRC, ">>matcherrc");
259         print MATCHERRC @new_filters;
260 close(MATCHERRC);
261
262 print "Converted ". ($#new_filters-1) . " filters\n";
263 if ($disabled) {
264         print "[$disabled disabled filter(s) not converted]\n";
265 }
266
267 exit;
268
269 sub clean_me {
270         my ($dirty) = @_;
271
272         $dirty =~ s/\"/\\\"/g;
273         $dirty =~ s/\n/ /g;
274
275         return $dirty;
276 }
277