280 lines
7.5 KiB
Perl
Executable File
280 lines
7.5 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
|
|
use strict;
|
|
use XML::SimpleObject;
|
|
|
|
# * This file is free software; you can redistribute it and/or modify it
|
|
# * under the terms of the GNU General Public License as published by
|
|
# * the Free Software Foundation; either version 3 of the License, or
|
|
# * (at your option) any later version.
|
|
# *
|
|
# * This program is distributed in the hope that it will be useful, but
|
|
# * WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
# * General Public License for more details.
|
|
# *
|
|
# * You should have received a copy of the GNU General Public License
|
|
# * along with this program; if not, write to the Free Software
|
|
# * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
|
# *
|
|
# * Copyright 2006 Paul Mangan <paul@claws-mail.org>
|
|
# *
|
|
|
|
#
|
|
# Convert new style Sylpheed filter rules (Sylpheed >= 0.9.99) to
|
|
# Claws Mail filtering rules
|
|
#
|
|
|
|
#
|
|
# TABLE OF EQUIVALENTS
|
|
#
|
|
# SYLPHEED : Claws Mail
|
|
#------------------------------------------------------
|
|
#
|
|
# NAME
|
|
#
|
|
# name : rulename
|
|
#
|
|
# CONDITION LIST
|
|
#
|
|
# bool or : |
|
|
# bool and : &
|
|
#
|
|
# match-header (name From) : from
|
|
# match-header (name To) : to
|
|
# match-header (name Cc) : cc
|
|
# match-header (name Subject) : subject
|
|
# else...
|
|
# match-header : header
|
|
#
|
|
# match-header (type contains) : [nothing]
|
|
# match-header (type not-contain) : [append with ~]
|
|
# match-header (type is) : [no equivalent] (use type contains)
|
|
# match-header (type is-not) : [no equivalent] (use type not-contain)
|
|
# match-header (type regex) : regexpcase
|
|
# match-header (type not-regex) : regexpcase [append with ~]
|
|
#
|
|
# matcher-any-header ; headers-part
|
|
# match-to-or-cc : to_or_cc
|
|
# match-body-text : body_part
|
|
# command-test : test
|
|
# size (type gt) : size_greater
|
|
# size (type lt) : size_smaller
|
|
# age (type gt) : age_greater
|
|
# age (type lt) : age_lower
|
|
#
|
|
# ACTION LIST
|
|
#
|
|
# move : move
|
|
# copy : copy
|
|
# not-receive : [no equivalent] (use type delete)
|
|
# delete : delete
|
|
# mark : mark
|
|
# color-label : color
|
|
# mark-as-read : mark_as_read
|
|
# exec : execute
|
|
# stop-eval : stop
|
|
#
|
|
|
|
my $old_config = "$ENV{HOME}/.sylpheed-2.0/filter.xml";
|
|
my $older_config = "$ENV{HOME}/.sylpheed/filter.xml";
|
|
my $old_filters;
|
|
|
|
my $config_dir = `claws-mail --config-dir` or die("ERROR:
|
|
You don't appear to have Claws Mail installed\n");
|
|
chomp $config_dir;
|
|
|
|
chdir($ENV{HOME} . "/$config_dir") or die("ERROR:
|
|
Claws Mail config directory not found [~/$config_dir]
|
|
You need to run Claws Mail once, quit it, and then rerun this script\n");
|
|
|
|
if (-e $old_config) {
|
|
$old_filters = $old_config;
|
|
} elsif (-e $older_config) {
|
|
$old_filters = $older_config;
|
|
} else {
|
|
print "ERROR:\n\tSylpheed filter not found\n\t[$old_config]\n\t[$older_config]\n";
|
|
exit;
|
|
}
|
|
|
|
my $claws_version = `claws-mail --version`;
|
|
$claws_version =~ s/^Claws Mail version //;
|
|
|
|
my ($major, $minor) = split(/\./, $claws_version);
|
|
|
|
my $version_test = 0;
|
|
if ($major > 2 || ($major == 2 && $minor >= 3)) {
|
|
$version_test = 1;
|
|
}
|
|
|
|
my $parser = XML::Parser->new(ErrorContext => 2, Style => "Tree");
|
|
my $xmlobj = XML::SimpleObject->new($parser->parsefile($old_filters));
|
|
|
|
my @conditions = ('match-header','match-to-or-cc','match-any-header',
|
|
'match-body-text','command-test','size','age');
|
|
|
|
my @actions = ('copy','not-receive','mark','color-label','mark-as-read',
|
|
'exec','stop-eval','move','delete');
|
|
|
|
my $standard_headers = qr/^(?:Subject|From|To|Cc)$/;
|
|
my $negative_matches = qr/^(?:not-contain|is-not|not-regex)$/;
|
|
my $numeric_matches = qr/^(?:size|age)$/;
|
|
my $exact_matches = qr/^(?:move|copy|delete|mark)$/;
|
|
|
|
my @new_filters = ("[filtering]");
|
|
|
|
my $disabled = 0;
|
|
my $bool;
|
|
|
|
## rules list
|
|
foreach my $element ($xmlobj->child("filter")->children("rule")) {
|
|
my $new_filter = "\n";
|
|
if ($element->attribute("enabled")) {
|
|
if ($element->attribute("enabled") eq "false") {
|
|
if ($version_test) {
|
|
$new_filter .= "disabled ";
|
|
} else {
|
|
$disabled++;
|
|
next; # skip disabled rules
|
|
}
|
|
} elsif ($version_test) {
|
|
$new_filter .= "enabled ";
|
|
}
|
|
}
|
|
if ($element->attribute("name")) {
|
|
my $name = $element->attribute("name");
|
|
$name = clean_me($name);
|
|
$new_filter .= "rulename \"$name\" ";
|
|
}
|
|
## condition list
|
|
foreach my $parent ($element->children("condition-list")) {
|
|
if ($parent->attribute("bool")) {
|
|
$bool = $parent->attribute("bool");
|
|
$bool =~ s/or/|/;
|
|
$bool =~ s/and/&/;
|
|
}
|
|
foreach my $condition (@conditions) {
|
|
my $new_condition = 0;
|
|
my $type;
|
|
if ($parent->children("$condition")) {
|
|
foreach my $sibling ($parent->children("$condition")) {
|
|
if ($new_condition) {
|
|
$new_filter .= " $bool ";
|
|
}
|
|
if ($sibling->attribute("type")) {
|
|
$type = $sibling->attribute("type");
|
|
if ($type =~ m/$negative_matches/) {
|
|
$new_filter .= '~';
|
|
}
|
|
}
|
|
if ($sibling->attribute("name")) {
|
|
my $name = $sibling->attribute("name");
|
|
if ($condition eq "match-header") {
|
|
if ($name =~ m/$standard_headers/) {
|
|
$new_filter .= lc($name) . " ";
|
|
} else {
|
|
$new_filter .= "header \"$name\" ";
|
|
}
|
|
}
|
|
}
|
|
if ($condition eq "match-any-header") {
|
|
$new_filter .= "headers_part ";
|
|
} elsif ($condition eq "match-header-content") {
|
|
$new_filter .= "headers_cont ";
|
|
} elsif ($condition eq "match-to-or-cc") {
|
|
$new_filter .= "to_or_cc ";
|
|
} elsif ($condition eq "match-body-text") {
|
|
$new_filter .= "body_part ";
|
|
} elsif ($condition eq "command-test") {
|
|
$new_filter .= "test ";
|
|
} elsif ($condition eq "size") {
|
|
if ($type eq "gt") {
|
|
$new_filter .= "size_greater ";
|
|
} else {
|
|
$new_filter .= "size_smaller ";
|
|
}
|
|
} elsif ($condition eq "age") {
|
|
if ($type eq "gt") {
|
|
$new_filter .= "age_greater ";
|
|
} else {
|
|
$new_filter .= "age_lower ";
|
|
}
|
|
}
|
|
if ($condition !~ m/$numeric_matches/ &&
|
|
$condition ne "command-test") {
|
|
if ($type =~ m/regex/) {
|
|
$new_filter .= "regexpcase ";
|
|
} else {
|
|
$new_filter .= "matchcase ";
|
|
}
|
|
}
|
|
my $value = clean_me($sibling->value);
|
|
if ($condition =~ m/$numeric_matches/) {
|
|
$new_filter .= "$value";
|
|
} else {
|
|
$new_filter .= "\"$value\"";
|
|
}
|
|
$new_condition++;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
## end of condition list
|
|
## action list
|
|
foreach my $parent ($element->children("action-list")) {
|
|
foreach my $action (@actions) {
|
|
if ($parent->children("$action")) {
|
|
foreach my $sibling ($parent->children("$action")) {
|
|
if ($action =~ m/$exact_matches/) {
|
|
$new_filter .= " $action";
|
|
} elsif ($action eq "not-receive") {
|
|
$new_filter .= " delete";
|
|
} elsif ($action eq "color-label") {
|
|
$new_filter .= " color";
|
|
} elsif ($action eq "mark-as-read") {
|
|
$new_filter .= " mark_as_read";
|
|
} elsif ($action eq "exec") {
|
|
$new_filter .= " execute";
|
|
} elsif ($action eq "stop-eval") {
|
|
$new_filter .= " stop";
|
|
}
|
|
if ($sibling->value) {
|
|
my $value = clean_me($sibling->value);
|
|
if ($action eq "color-label") {
|
|
$new_filter .= " $value";
|
|
} else {
|
|
$new_filter .= " \"$value\"";
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
## end of action list
|
|
push(@new_filters, $new_filter) if (defined($new_filter));
|
|
}
|
|
## end of rules list
|
|
push(@new_filters, "\n");
|
|
|
|
# write new config
|
|
open(MATCHERRC, ">>matcherrc");
|
|
print MATCHERRC @new_filters;
|
|
close(MATCHERRC);
|
|
|
|
print "Converted ". ($#new_filters-1) . " filters\n";
|
|
if ($disabled) {
|
|
print "[$disabled disabled filter(s) not converted]\n";
|
|
}
|
|
|
|
exit;
|
|
|
|
sub clean_me {
|
|
my ($dirty) = @_;
|
|
|
|
$dirty =~ s/\"/\\\"/g;
|
|
$dirty =~ s/\n/ /g;
|
|
|
|
return $dirty;
|
|
}
|
|
|