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