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-header-content") {
 183                                                 $new_filter .= "headers_cont ";
 184                                         } elsif ($condition eq "match-to-or-cc") {
 185                                                 $new_filter .= "to_or_cc ";
 186                                         } elsif ($condition eq "match-body-text") {
 187                                                 $new_filter .= "body_part ";
 188                                         } elsif ($condition eq "command-test") {
 189                                                 $new_filter .= "test ";
 190                                         } elsif ($condition eq "size") {
 191                                                 if ($type eq "gt") {
 192                                                         $new_filter .= "size_greater ";
 193                                                 } else {
 194                                                         $new_filter .= "size_smaller ";
 195                                                 }
 196                                         } elsif ($condition eq "age") {
 197                                                 if ($type eq "gt") {
 198                                                         $new_filter .= "age_greater ";
 199                                                 } else {
 200                                                         $new_filter .= "age_lower ";
 201                                                 }
 202                                         }
 203                                         if ($condition !~ m/$numeric_matches/ &&
 204                                             $condition ne "command-test") {
 205                                                 if ($type =~ m/regex/) {
 206                                                         $new_filter .= "regexpcase ";
 207                                                 } else {
 208                                                         $new_filter .= "matchcase ";
 209                                                 }
 210                                         }
 211                                         my $value = clean_me($sibling->value);
 212                                         if ($condition =~ m/$numeric_matches/) {
 213                                                 $new_filter .= "$value";
 214                                         } else {
 215                                                 $new_filter .= "\"$value\"";
 216                                         }
 217                                         $new_condition++;
 218                                 }
 219                         }
 220                 }
 221         }
 222 ## end of condition list
 223 ## action list
 224         foreach my $parent ($element->children("action-list")) {
 225                 foreach my $action (@actions) {
 226                         if ($parent->children("$action")) {
 227                                 foreach my $sibling ($parent->children("$action")) {
 228                                         if ($action  =~ m/$exact_matches/) {
 229                                                 $new_filter .= " $action";
 230                                         } elsif ($action eq "not-receive") {
 231                                                 $new_filter .= " delete";
 232                                         } elsif ($action eq "color-label") {
 233                                                 $new_filter .= " color";
 234                                         } elsif ($action eq "mark-as-read") {
 235                                                 $new_filter .= " mark_as_read";
 236                                         } elsif ($action eq "exec") {
 237                                                 $new_filter .= " execute";
 238                                         } elsif ($action eq "stop-eval") {
 239                                                 $new_filter .= " stop";
 240                                         }
 241                                         if ($sibling->value) {
 242                                                 my $value = clean_me($sibling->value);
 243                                                 if ($action eq "color-label") {
 244                                                         $new_filter .= " $value";
 245                                                 } else {
 246                                                         $new_filter .= " \"$value\"";
 247                                                 }
 248                                         }
 249                                 }
 250                         }
 251                 }
 252         }
 253 ## end of action list
 254         push(@new_filters, $new_filter) if (defined($new_filter));
 255 }
 256 ## end of rules list
 257 push(@new_filters, "\n");
 258
 259 # write new config
 260 open(MATCHERRC, ">>matcherrc");
 261         print MATCHERRC @new_filters;
 262 close(MATCHERRC);
 263
 264 print "Converted ". ($#new_filters-1) . " filters\n";
 265 if ($disabled) {
 266         print "[$disabled disabled filter(s) not converted]\n";
 267 }
 268
 269 exit;
 270
 271 sub clean_me {
 272         my ($dirty) = @_;
 273
 274         $dirty =~ s/\"/\\\"/g;
 275         $dirty =~ s/\n/ /g;
 276
 277         return $dirty;
 278 }
 279