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 $older_config = "$ENV{HOME}/.sylpheed/filter.xml";
  82 my $old_filters;
  83
  84 my $config_dir = `sylpheed-claws --config-dir` or die("ERROR:
  85         You don't appear to have Sylpheed-Claws installed\n");
  86 chomp $config_dir;
  87
  88 chdir($ENV{HOME} . "/$config_dir") or die("ERROR:
  89         Sylpheed-Claws config directory not found [~/$config_dir]
  90         You need to run Sylpheed-Claws once, quit it, and then rerun this script\n");
  91
  92 if (-e $old_config) {
  93         $old_filters = $old_config;
  94 } elsif (-e $older_config) {
  95         $old_filters = $older_config;
  96 } else {
  97         print "ERROR:\n\tSylpheed filter not found\n\t[$old_config]\n\t[$older_config]\n";
  98         exit;
  99 }
 100
 101 my $parser = XML::Parser->new(ErrorContext => 2, Style => "Tree");
 102 my $xmlobj = XML::SimpleObject->new($parser->parsefile($old_filters));
 103
 104 my @conditions = ('match-header','match-to-or-cc','match-any-header',
 105                   'match-body-text','command-test','size','age');
 106
 107 my @actions = ('move','copy','not-receive','delete','mark','color-label',
 108                'mark-as-read','exec','stop-eval');
 109
 110 my $standard_headers = qr/^(?:Subject|From|To|Cc)$/;
 111 my $negative_matches = qr/^(?:not-contain|is-not|not-regex)$/;
 112 my $numeric_matches = qr/^(?:size|age)$/;
 113 my $exact_matches = qr/^(?:move|copy|delete|mark)$/;
 114
 115 my @new_filters = ("[filtering]");
 116
 117 my $disabled = 0;
 118 my $bool;
 119
 120 ## rules list
 121 foreach my $element ($xmlobj->child("filter")->children("rule")) {
 122         my $new_filter;
 123         if ($element->attribute("name")) {
 124                 my $name = $element->attribute("name");
 125                 $name = clean_me($name);
 126                 $new_filter = "\nrulename \"$name\" ";
 127         }
 128         if ($element->attribute("enabled")) {
 129                 if ($element->attribute("enabled") eq "false") {
 130                         $disabled++;
 131                         next;   # skip disabled rules
 132                 }
 133         }
 134 ## condition list
 135         foreach my $parent ($element->children("condition-list")) {
 136                 if ($parent->attribute("bool")) {
 137                         $bool = $parent->attribute("bool");
 138                         $bool =~ s/or/|/;
 139                         $bool =~ s/and/&/;
 140                 }
 141                 foreach my $condition (@conditions) {
 142                         my $new_condition = 0;
 143                         my $type;
 144                         if ($parent->children("$condition")) {
 145                                 foreach my $sibling ($parent->children("$condition")) {
 146                                         if ($new_condition) {
 147                                                 $new_filter .= " $bool ";
 148                                         }
 149                                         if ($sibling->attribute("type")) {
 150                                                 $type = $sibling->attribute("type");
 151                                                 if ($type =~ m/$negative_matches/) {
 152                                                         $new_filter .= '~';
 153                                                 }
 154                                         }
 155                                         if ($sibling->attribute("name")) {
 156                                                 my $name = $sibling->attribute("name");
 157                                                 if ($condition eq "match-header") {
 158                                                         if ($name =~ m/$standard_headers/) {
 159                                                                 $new_filter .= lc($name) . " ";
 160                                                         } else {
 161                                                                 $new_filter .= "header \"$name\" ";
 162                                                         }
 163                                                 }
 164                                         }
 165                                         if ($condition eq "match-any-header") {
 166                                                 $new_filter .= "headers_part ";
 167                                         } elsif ($condition eq "match-to-or-cc") {
 168                                                 $new_filter .= "to_or_cc ";
 169                                         } elsif ($condition eq "match-body-text") {
 170                                                 $new_filter .= "body_part ";
 171                                         } elsif ($condition eq "command-test") {
 172                                                 $new_filter .= "test ";
 173                                         } elsif ($condition eq "size") {
 174                                                 if ($type eq "gt") {
 175                                                         $new_filter .= "size_greater ";
 176                                                 } else {
 177                                                         $new_filter .= "size_smaller ";
 178                                                 }
 179                                         } elsif ($condition eq "age") {
 180                                                 if ($type eq "gt") {
 181                                                         $new_filter .= "age_greater ";
 182                                                 } else {
 183                                                         $new_filter .= "age_lower ";
 184                                                 }
 185                                         }
 186                                         if ($condition !~ m/$numeric_matches/ &&
 187                                             $condition ne "command-test") {
 188                                                 if ($type =~ m/regex/) {
 189                                                         $new_filter .= "regexpcase ";
 190                                                 } else {
 191                                                         $new_filter .= "matchcase ";
 192                                                 }
 193                                         }
 194                                         my $value = clean_me($sibling->value);
 195                                         if ($condition =~ m/$numeric_matches/) {
 196                                                 $new_filter .= "$value";
 197                                         } else {
 198                                                 $new_filter .= "\"$value\"";
 199                                         }
 200                                         $new_condition++;
 201                                 }
 202                         }
 203                 }
 204         }
 205 ## end of condition list
 206 ## action list
 207         foreach my $parent ($element->children("action-list")) {
 208                 foreach my $action (@actions) {
 209                         if ($parent->children("$action")) {
 210                                 foreach my $sibling ($parent->children("$action")) {
 211                                         if ($action  =~ m/$exact_matches/) {
 212                                                 $new_filter .= " $action";
 213                                         } elsif ($action eq "not-receive") {
 214                                                 $new_filter .= " delete";
 215                                         } elsif ($action eq "color-label") {
 216                                                 $new_filter .= " color";
 217                                         } elsif ($action eq "mark-as-read") {
 218                                                 $new_filter .= " mark_as_read";
 219                                         } elsif ($action eq "exec") {
 220                                                 $new_filter .= " execute";
 221                                         } elsif ($action eq "stop-eval") {
 222                                                 $new_filter .= " stop";
 223                                         }
 224                                         if ($sibling->value) {
 225                                                 my $value = clean_me($sibling->value);
 226                                                 if ($action eq "color-label") {
 227                                                         $new_filter .= " $value";
 228                                                 } else {
 229                                                         $new_filter .= " \"$value\"";
 230                                                 }
 231                                         }
 232                                 }
 233                         }
 234                 }
 235         }
 236 ## end of action list
 237         push(@new_filters, $new_filter) if (defined($new_filter));
 238 }
 239 ## end of rules list
 240 push(@new_filters, "\n");
 241
 242 # write new config
 243 open(MATCHERRC, ">>matcherrc");
 244         print MATCHERRC @new_filters;
 245 close(MATCHERRC);
 246
 247 print "Converted ". ($#new_filters-1) . " filters\n";
 248 if ($disabled) {
 249         print "[$disabled disabled filter(s) not converted]\n";
 250 }
 251
 252 exit;
 253
 254 sub clean_me {
 255         my ($dirty) = @_;
 256
 257         $dirty =~ s/\"/\\\"/g;
 258         $dirty =~ s/\n/ /g;
 259
 260         return $dirty;
 261 }
 262