claws-mail/tools/thunderbird-filters-convertor.pl

#!/usr/bin/perl -w

use strict;
use Getopt::Long;
use URI::Escape;

#  * 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 2007 Paul Mangan <paul@claws-mail.org>
#  *

#
# Convert Thunderbird filtering rules to Claws Mail filtering rules
#

#
# TABLE OF EQUIVALENTS
#
# thunderbird			:	Claws Mail
#------------------------------------------------------
#
# name="NAME"			:	rulename "NAME"
#
# enabled="yes"			:	enabled / disabled
#
# CONDITION LIST
# --------------
#
# OR				:	|
# AND				:	&
#
# subject			:	subject
# from				:	from
# to				:	to
# cc				:	cc
# to or cc			:	to_or_cc
# body				:	body-part
# date				:	****
# priority			:	****
# status			:	****
# age in days			:	age_greater/age_lower
# size				:	size_greater/size_smaller
# [custom header]		:	header
#
# 2nd level conditions
# --------------------
#
# contains			:	[nothing]
# doesn't contain		:	[append with ~]
# is				:	regexpcase
# isn't				:	regexpcase
# ends with			:	regexpcase
# begins with			:	regexpcase
# is in ab			:	found_in_addressbook
# isn't in ab			:	~found_in_addressbook
#
#
# status 2nd and 3rd level conditions
# -----------------------------------
#
# [is|isn't] replied
# [is|isn't] read
# [is|isn't] new
# [is|isn't] forwarded
# [is|isn't] flagged
#
#
# Date header 2nd  level condition
# --------------------------------
#
# is
# isn't
# is before
# is after
#
#
# Priority header 2nd and 3rd level conditions
# --------------------------------------------
# is 		 [Lowest|Low|Normal|High|Highest]
# is higher than [Lowest|Low|Normal|High|Highest]
# is lower than  [Lowest|Low|Normal|High|Highest]
# 
#
# ACTION LIST
# -----------
#
# Move to folder		:	move
# Copy to folder		:	copy
# Forward			:	****
# Reply				:	****
# Mark read			:	mark_as_read
# Mark flagged			:	mark
# Label				:	****
# Change priority		:	****
# JunkScore 100 [mark as spam]	:	****
# JunkScore 0 [mark as ham]	:	****
# Delete			:	delete
# Delete from Pop3 server	:	delete
# Fetch body from Pop3Server	:	****
#

my $script = "thunderbird-filters-convertor.pl";
my ($tbirdfile, $account, $mailbox, $iNeedHelp) = 0;

GetOptions("tbird-file=s"	=> \$tbirdfile,
	   "account-name=s"	=> \$account,
	   "mailbox-name=s"	=> \$mailbox,
	   "help|h"		=> \$iNeedHelp);

if ($iNeedHelp) {
	help_me();
}

if (!$tbirdfile) {
	print "ERROR: No filename given\n";
	print "Use $script -h for help\n";
	exit;
}

unless (-e $tbirdfile) {
	print "ERROR: $tbirdfile NOT FOUND!!\n";
	exit;
}

if (!$mailbox) {
	print "ERROR: No mailbox name given\n";
	print "Use $script -h for help\n";
	exit;
}

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 re-run this script\n");

my $acrc = "accountrc";
my $acc_number;

if ($account) {
	$acc_number = find_account_number();
}
if ($account && !$acc_number) {
	print "ERROR: Account '$account' NOT FOUND!\n";
	exit;
}

my @claws_filters = ();

## check if matcherrc already exists
if (-e "matcherrc") {
	print "matcherrc exists!\n";
	read_current_filters();
} else {
	push(@claws_filters, "[preglobal]\n\n[postglobal]\n\n[filtering]\n")
}
##
my ($rule_count,@thunderbird_filters)  = read_thunderbird_filters();

my ($conv_rule,$ignored_rule,$ignore_list) = convert_filters($rule_count,@thunderbird_filters);

if (@claws_filters) {
	system("mv matcherrc matcherrc-safecopy");
	print "Moved ". $ENV{HOME}. "/$config_dir/matcherrc to "
	      . $ENV{HOME}. "/$config_dir/matcherrc-safecopy\n";
}
# write new config
open(MATCHERRC, ">>matcherrc");
	print MATCHERRC @claws_filters;
close(MATCHERRC);

print "We're done!\n";
print "-------------\n";
print "Converted $conv_rule rules";
if (defined($ignored_rule)) {
	print ", ignored $ignored_rule rules";
}
print "\n-------------\n";
print "$ignore_list";

exit;

sub help_me {
	print<<'EOH';
Usage:	
	thunderbird-filters-convertor.pl [options]
Options:
	--help -h			Show this screen.
	--tbird-file=PATH TO FILE	The full path to the file to be converted
	--mailbox-name=NAME		The name of the Claws Mail mailbox
	--account-name=NAME		The name of the account to be used (optional)	
EOH
exit;
}

sub find_account_number {
	my $cur_acc_numb;
	my $cur_acc_name;

	open (ACCOUNTRC, "<$acrc") || 
		die("Can't open the Accounts file [$acrc]\n");
		my @acrclines = <ACCOUNTRC>;
	close ACCOUNTRC;
	
	foreach my $line (@acrclines) {
		unless ($line =~ m/^\[Account/ || 
			$line =~ m/^account_name/) { next; }
		chomp($line);

		if ($line =~ s/^\[Account: //) {
			$line =~ s/]$//;
			$cur_acc_numb = $line;
		}
		if ($line =~ s/^account_name=//) {
			$cur_acc_name = $line;
		}
		if (defined($cur_acc_name) && $cur_acc_name eq $account) {
			return($cur_acc_numb);
		}
	}
}

sub read_current_filters {
	print "Reading current filters\n";

	open (CFILTERS, "<matcherrc") || 
		die("Can't open " . $ENV{HOME} . "/$config_dir/matcherrc");
		@claws_filters = <CFILTERS>;
	close CFILTERS;

	remove_last_empty_lines();
}

sub remove_last_empty_lines {
	my $line = pop(@claws_filters);
	if ($line =~ m/^$/) {
		remove_last_empty_lines();
	} else {
		push(@claws_filters, $line);
	}
}

sub read_thunderbird_filters {
	my @outer_array = ();
	my @inner_array = ();
	my $count = 0;

	open (TBIRDFILE, "<$tbirdfile") || 
		die("Can't open the tbird file [$tbirdfile]\n");
		my @tbirdlines = <TBIRDFILE>;
	close TBIRDFILE;

	foreach my $line (@tbirdlines) {
		if ($line =~ m/^version/ || $line =~ m/^logging/) { next; }

		chomp($line);

		push(@inner_array, "$line") unless $line eq "";
		if ($line =~ m/^condition/) {
			push(@outer_array, [@inner_array]);
			@inner_array = ();
			$count++;
		}
	}
	return($count-1,@outer_array);
}

sub convert_filters {
	my ($rule_count,@thunderbird_filters) = @_;

	my $tbird_action_no_value = qr/^(?:"Mark read"|"Mark flagged"|"Delete"|"Delete from Pop3 server"|"Fetch body from Pop3Server")$/;
	my $tbird_action_ignore = qr/^(?:"Label"|"Change priority"|"JunkScore"|"Fetch body from Pop3Server"|"Delete from Pop3 server"|"Reply")$/;
	my $exact_matches = qr/^(?:subject|from|to|cc)$/;
	my $ignore_matches = qr/^(?:date|priority|status)$/;

	my $conv_rules = my $ignored_rules = 0;
	my $ignored_list = "";
	for (my $outerloop = 0; $outerloop <= $rule_count; $outerloop++) {
		my $part_one = my $part_two = my $part_three = my $part_four = "";
		my $ignore_rule = my $move_rule = my $copy_rule = my $cond_count = 0;
		my %ignore_hash;
		my $bool = my $claws_condition = my $cur_name = "";
		for (my $innerloop = 0; exists($thunderbird_filters[$outerloop][$innerloop]); $innerloop++) {
			my $entry = $thunderbird_filters[$outerloop][$innerloop];
			if ($entry =~ s/^name=//) {
				$cur_name = $entry;
				$part_one = "rulename $entry ";
			} elsif ($entry =~ s/^enabled=//) {
				if ($entry eq "\"yes\"") {
					$part_one = "enabled $part_one";
				} else {
					$part_one = "disabled $part_one";
				}
				if (defined($acc_number)) {
					$part_one .= "account $acc_number ";
				}
			} elsif ($entry =~ s/^type=//) {
				# do nothing : what does 'type' mean??
			} elsif ($entry =~ s/^action=//) {
				if ($entry =~ m/$tbird_action_ignore/ && !$ignore_rule) {
					$ignore_rule = 1;
					unless ($ignore_hash{$cur_name}) {
						$ignored_list .= "Ignored $cur_name because it contains $entry\n";
						$ignored_rules++;
					}
					$ignore_hash{$cur_name}++;
					$part_one = "";
					next;
				} elsif ($entry =~ m/Move to folder/) {
					$part_four = "move ";
					$move_rule = 1;
				} elsif ($entry =~ m/Copy to folder/) {
					$part_three .= "copy";
					$copy_rule = 1;
				} elsif ($entry =~ m/Mark read/) {
					$part_three .= "mark_as_read ";
				} elsif ($entry =~ m/Mark flagged/) {
					$part_three .= "mark";
				} elsif ($entry =~ m/Delete/) {
					$part_three .= "delete";
				}
			} elsif ($entry =~ s/^actionValue=//) {
				if ($ignore_rule) {
					$ignore_rule = 0;
					next;
				} elsif ($move_rule) {
					$entry = rewrite_mailbox_name($entry);
					$part_four .= uri_unescape($entry);
					$move_rule = 0;					
				} elsif ($copy_rule) {
					$entry = rewrite_mailbox_name($entry);
					$part_three .= " " . uri_unescape($entry);
					$copy_rule = 0;
				}
			} elsif ($entry =~ s/^condition=//) {
				if ($entry =~ s/^\"AND//) {
					$bool= "&";
				} elsif ($entry =~ s/^\"OR//) {
					$bool = "|";
				}
				my @tbird_conditions = split(/ \(/, $entry);
				foreach my $cond (@tbird_conditions) {
					my $exact = my $endswith = my $beginswith = my $addrbook = 0;
					my $age_condition = my $size_condition = my $exact_age = 0;
					$cond =~ s/\) OR$//;
					$cond =~ s/\) AND$//;
					$cond =~ s/\)"$//;
					my ($cpart_one, $cpart_two, $cpart_thr) = split(/,/, $cond, 3);
					if ($cond) {
						if ($cpart_one =~ m/$exact_matches/) {
							$claws_condition .= "$cpart_one";
						} elsif ($cpart_one eq "to or cc") {
							$claws_condition .= "to_or_cc";
						} elsif ($cpart_one eq "body") {
							$claws_condition .= "body-part";
						} elsif ($cpart_one eq "age in days") {
							$age_condition = 1;
						} elsif ($cpart_one eq "size") {
							$size_condition = 1;
						} elsif ($cpart_one =~ m/$ignore_matches/) {
							$part_one = $claws_condition = $part_three = $part_four = "";
							next;
						} else {
							$claws_condition = "head";
						}

						if ($cpart_two eq "doesn't contain") {
							$claws_condition = "~$claws_condition matchcase";
						} elsif ($cpart_two eq "contains") {
							$claws_condition = "$claws_condition matchcase";
						} elsif ($cpart_two eq "isn't") {
							$exact = 1;
							$claws_condition = "~$claws_condition regexpcase";
						} elsif ($cpart_two eq "is") {
							if ($size_condition) {
								$claws_condition .= "size_equal";
							} elsif ($age_condition) {
								if ($bool ne "&") {
									$part_one = $claws_condition = $part_three = $part_four = "";
									if (!$ignored_list) {
										$ignored_list .= "Ignored $cur_name because it matches an exact age and is an OR match\n";
									}
									next;
								} else {
									$ignored_rules--;
									$exact_age = 1;
								}
							} else {
								$exact = 1;
								$claws_condition = "$claws_condition regexpcase";
							}
						} elsif ($cpart_two eq "ends with") {
							$endswith = 1;
							$claws_condition = "$claws_condition regexpcase";
						} elsif ($cpart_two eq "begins with") {
							$beginswith = 1;
							$claws_condition = "$claws_condition regexpcase";
						} elsif ($cpart_two eq "is in ab") {
							$addrbook = 1;
							$claws_condition = "found_in_addressbook \"$claws_condition\" in \"Any\" ";
						} elsif ($cpart_two eq "isn't in ab") {
							$addrbook = 1;
							$claws_condition = "~found_in_addressbook \"$claws_condition\" in \"Any\" ";
						} elsif ($cpart_two eq "is greater than") {
							if ($size_condition) {
								$claws_condition .= "size_greater";
							}
							if ($age_condition) {
								$claws_condition .= "age_greater";
							}
						} elsif ($cpart_two eq "is less than") {
							if ($size_condition) {
								$claws_condition .= "size_smaller";
							}
							if ($age_condition) {
								$claws_condition .= "age_lower";
							}
						}							
				
						if ($exact || $beginswith || $endswith) {
							$cpart_thr = escape_regex($cpart_thr);
						}
						if ($exact) {
							$cpart_thr = "^$cpart_thr\$";
						} elsif ($beginswith) {
							$cpart_thr = "^$cpart_thr";
						} elsif ($endswith) {
							$cpart_thr = "$cpart_thr\$";
						}
						unless ($addrbook) {
							if ($exact_age) {
								my $lower_limit = $cpart_thr-1;
								my $upper_limit = $cpart_thr+1;
								$lower_limit =~ s/^\"//;
								$lower_limit =~ s/\"$//;
								$upper_limit =~ s/^\"//;
								$upper_limit =~ s/\"$//;
								$claws_condition = "$claws_condition"."age_lower"
											 . " $upper_limit $bool "
											 . "age_greater $lower_limit ";
							} elsif ($size_condition || $age_condition) {
								$claws_condition = "$claws_condition $cpart_thr ";
							} else {	
								$claws_condition = "$claws_condition \"$cpart_thr\" ";
							}
						}

						if ($tbird_conditions[1] && $cond_count < $#tbird_conditions) {
							$claws_condition = "$claws_condition$bool ";
						}
					}
					$cond_count++;
				}
				if ($part_one) {
					$conv_rules++;
					push(@claws_filters, "$part_one$claws_condition$part_three$part_four\n");
				}
			}
		}
	}
	push(@claws_filters, "\n");
	return($conv_rules,$ignored_rules,$ignored_list);
}

sub rewrite_mailbox_name {
	my ($path) = @_;

	my $new_path;

	my ($front,$back) = split(/\/\//, $path, 2);

	if ($front =~ m/^"mailbox/) {
		$new_path = "\"#mh/$mailbox/";
	} else {
		$new_path = "\"#imap/$mailbox/";
	}

	my ($box,$name) = split(/\//, $back, 2);

	if ($new_path =~ m/^"#mh/) {
		$name =~ s/^Inbox/inbox/;
		$name =~ s/^Sent/sent/;
		$name =~ s/^Drafts/draft/;
		$name =~ s/^Trash/trash/;
	}
	$new_path = $new_path.$name;

	return($new_path);
}

sub escape_regex {
	my ($string) = @_;

	my $escstr = "";
	my $symbols = qr/^(?:\[|\]|\{|\}|\(|\)|\||\+|\*|\.|\-|\$|\^)$/;
	my @chars = split(//, $string);

	foreach my $char (@chars) {
		if ($char =~ m/$symbols/) { $char = "\\\\$char"; }
		$escstr .= $char;
	}

	return($escstr);
}