5372372061def398089161428e69298281cabec0
[claws.git] / src / plugins / perl / tools / matcherrc2perlfilter.pl
1 #!/usr/bin/perl -w
2 #
3 ## script purpose : convert matcherrc filtering rules into
4 ##                  perl_filter rules
5 #
6 # This conversion-tool doesn't produce nice Perl code and is just
7 # intended to get you started. If you choose to use the Perl plugin,
8 # consider rewriting your rules.
9 #
10 # Copyright (C) 2004 Holger Berndt
11 #
12 #
13 # This file is free software; you can redistribute it and/or modify it
14 # under the terms of the GNU General Public License as published by
15 # the Free Software Foundation; either version 3 of the License, or
16 # (at your option) any later version.
17 #
18 # This program is distributed in the hope that it will be useful, but
19 # WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
21 # General Public License for more details.
22 #
23 # You should have received a copy of the GNU General Public License
24 # along with this program. If not, see <http://www.gnu.org/licenses/>.
25
26 use strict;
27
28 our $warnings = 0;
29 our $lines    = 0;
30 our $tokens   = 0;
31
32 my $home_dir   = $ENV{"HOME"}; $home_dir ||= ".";
33 my $sylph_dir  = `claws-mail --config-dir`;
34 my $matcherrc  = "matcherrc";
35 my $perlfilter = "perl_filter";
36 my $dirsep     = "/";
37
38 chomp($sylph_dir); $sylph_dir =~ s/.*\n(.*)$/$1/;
39 my $inpath  = $home_dir.$dirsep.$sylph_dir.$dirsep.$matcherrc;
40 my $outpath = $home_dir.$dirsep.$sylph_dir.$dirsep.$perlfilter;
41 open IN,      $inpath  or die "Cannot open $inpath: $!";
42 open OUT,">>",$outpath or die "Cannot open $outpath: $!";
43
44 print "Filtering rules are read from `$inpath', converted to Perl\n";
45 print "syntax and appended to `$outpath'\n";
46 print "`$inpath' is not changed, so you might want to make a backup\n";
47 print "copy of it and then remove your former filtering rules\n";
48 print "---\n";
49 my $date = `date`;
50 chomp($date);
51 print OUT "### Begin: Rules converted by matcherrc2perlfilter.pl $date ###\n";
52 while(my $line = <IN>) {
53     $line =~ s/^\s*(.*)\s*$/$1/;
54     if($line =~ /^\[filtering\]$/i) {
55         while($line = <IN>) {
56             $line =~ s/^\s*(.*)\s*$/$1/;
57             next if $line =~ /^$/;
58             if($line =~ /^\[(.+)\]$/) {
59                 last unless ($1 =~ /filtering/i);
60             }
61             my @fields = splitline($line);
62             $lines++;
63             convert(@fields);
64         }
65     }
66 }
67 print "---\n" if $warnings;
68 print "Finished conversion of $lines rules with $warnings warnings.\n";
69 print OUT "### End: Rules converted by matcherrc2perlfilter.pl $date ###\n";
70
71 # convert a rule
72 sub convert {
73     my $act = 0;
74     my $output="(";
75     while(my $token = shift) {
76         $tokens++;
77         if($token eq "&") {
78             $token = shift;
79         }
80         elsif($token eq "|") {
81             $output =~ s/&& $/\|\| /;
82             $token = shift;
83         }
84         elsif($tokens != 1 and $act == 0) {
85             $act = 1;
86             if($output =~ / (&&|\|\|) $/) {
87                 $output =~ s/ (&&|\|\|) $/\) $1 /;
88             }
89             else {
90                 $output .= ")";
91             }
92         }
93
94         if($token eq "~") {
95             $output .= "!";
96             $token = shift;
97         }
98
99         if($token eq "all"           or
100            $token eq "marked"        or
101            $token eq "deleted"       or
102            $token eq "replied"       or
103            $token eq "forwarded"     or
104            $token eq "locked"        or
105            $token eq "unread"        or
106            $token eq "new"           or
107            $token eq "partial"       or
108            $token eq "ignore_thread" or
109            $token eq "mark"          or
110            $token eq "unmark"        or
111            $token eq "lock"          or
112            $token eq "unlock"        or
113            $token eq "stop"          or
114            $token eq "hide"          or
115            $token eq "mark_as_read"  or
116            $token eq "mark_as_unread") {
117             $output .= qq|($token) && |;
118         }
119         elsif($token eq "delete") {
120             $output .= qq|(dele) && |;
121         }
122         elsif($token eq "subject"       or
123               $token eq "from"          or
124               $token eq "to"            or
125               $token eq "cc"            or
126               $token eq "to_or_cc"      or
127               $token eq "newsgroups"    or
128               $token eq "inreplyto"     or
129               $token eq "references"    or
130               $token eq "headers_part"  or
131               $token eq "body_part"     or
132               $token eq "message") {
133             my $match = shift;
134             my $what  = shift;
135             $what =~ s/\\"/"/g;$what =~ s/'/\\'/g;
136             $what =~ s/^"(.*)"$/'$1'/;
137             $output .= qq|($match($token,$what)) && |;
138         }
139         elsif($token eq "age_greater"   or
140               $token eq "age_lower"     or
141               $token eq "colorlabel"    or
142               $token eq "score_greater" or
143               $token eq "score_lower"   or
144               $token eq "score_equal"   or
145               $token eq "size_greater"  or
146               $token eq "size_smaller"  or
147               $token eq "size_equal"    or
148               $token eq "move"          or
149               $token eq "copy"          or
150               $token eq "execute"       or
151               $token eq "color"         or
152               $token eq "test"          or
153               $token eq "change_score"  or
154               $token eq "set_score") {
155             my $arg = shift;
156             $arg =~ s/\\"/"/g;$arg =~ s/'/\\'/g;
157             $arg =~ s/^"(.*)"$/'$1'/;
158             $output .= qq|($token($arg)) && |;
159         }
160         elsif($token eq "header") {
161             my $headername = shift;
162             $headername =~ s/\\"/"/g;$headername =~ s/'/\\'/g;
163             $headername =~ s/^"(.*)"$/'$1'/;
164             my $match = shift;
165             my $what = shift;
166             $what =~ s/\\"/"/g;$what =~ s/'/\\'/g;          
167             $what =~ s/^"(.*)"$/'$1'/;
168             $output .= qq|($match($headername,$what)) && |;
169         }
170         elsif($token eq "stop") {
171             $output .= qq|(return) && |;
172         }
173         else {
174             print STDERR "WARNING: unknown token in $inpath ignored: $token\n";
175             $warnings++;
176         }
177     }
178     $output =~ s| && $|;\n|;
179     print OUT $output;
180     $tokens = 0;
181 }
182
183 # split the input line
184 sub splitline {
185     my @fields;
186     my $line = shift;
187     while($line) {
188         $line =~ s/^\s+//;
189         if($line =~ m#^"#) {
190            $line =~ s#^(".*?[^\\]")##;
191            push @fields,$1;
192         }
193         elsif($line =~ /^~/) {
194             $line =~ s#^(~)##;
195             push @fields,$1;
196         }
197         else {
198             $line =~ s#^(\S+)##;
199             push @fields,$1;
200         }
201     }
202     return @fields;
203 }