commit 9cf821fe5e395ac15c33af788ffa08ba6b48f602
parent 79c727f84f1b03eeab2292cfcd11bf617ca158be
Author: Ricardo Mones <mones@claws-mail.org>
Date: Thu, 28 Feb 2013 21:43:49 +0000
2013-02-28 [mones] 3.9.0cvs105
* configure.ac
* src/plugins/perl/Makefile.am
* src/plugins/perl/cm_perl.pod
* src/plugins/perl/tools/.cvsignore
* src/plugins/perl/tools/Makefile.am
* src/plugins/perl/tools/insert_perl.pl
* src/plugins/perl/tools/matcherrc2perlfilter.pl
Make perl plugin tools and manpage available into
distribution tarball.
Diffstat:
9 files changed, 1044 insertions(+), 1 deletion(-)
diff --git a/ChangeLog b/ChangeLog
@@ -1,3 +1,15 @@
+2013-02-28 [mones] 3.9.0cvs105
+
+ * configure.ac
+ * src/plugins/perl/Makefile.am
+ * src/plugins/perl/cm_perl.pod
+ * src/plugins/perl/tools/.cvsignore
+ * src/plugins/perl/tools/Makefile.am
+ * src/plugins/perl/tools/insert_perl.pl
+ * src/plugins/perl/tools/matcherrc2perlfilter.pl
+ Make perl plugin tools and manpage available into
+ distribution tarball.
+
2013-02-27 [mones] 3.9.0cvs104
* README
diff --git a/PATCHSETS b/PATCHSETS
@@ -4602,3 +4602,4 @@
( cvs diff -u -r 1.1.2.2 -r 1.1.2.3 src//plugins/vcalendar/libical/libical/Makefile.am; ) > 3.9.0cvs102.patchset
( cvs diff -u -r 1.94.2.242 -r 1.94.2.243 src/messageview.c; ) > 3.9.0cvs103.patchset
( cvs diff -u -r 1.8.2.67 -r 1.8.2.68 README; ) > 3.9.0cvs104.patchset
+( cvs diff -u -r 1.654.2.4681 -r 1.654.2.4682 configure.ac; cvs diff -u -r 1.1.2.4 -r 1.1.2.5 src/plugins/perl/Makefile.am; diff -u /dev/null src/plugins/perl/cm_perl.pod; diff -u /dev/null src/plugins/perl/tools/.cvsignore; diff -u /dev/null src/plugins/perl/tools/Makefile.am; diff -u /dev/null src/plugins/perl/tools/insert_perl.pl; diff -u /dev/null src/plugins/perl/tools/matcherrc2perlfilter.pl; ) > 3.9.0cvs105.patchset
diff --git a/configure.ac b/configure.ac
@@ -12,7 +12,7 @@ MINOR_VERSION=9
MICRO_VERSION=0
INTERFACE_AGE=0
BINARY_AGE=0
-EXTRA_VERSION=104
+EXTRA_VERSION=105
EXTRA_RELEASE=
EXTRA_GTK2_VERSION=
@@ -1840,6 +1840,7 @@ src/plugins/notification/Makefile
src/plugins/notification/gtkhotkey/Makefile
src/plugins/pdf_viewer/Makefile
src/plugins/perl/Makefile
+src/plugins/perl/tools/Makefile
src/plugins/python/Makefile
src/plugins/pgpcore/Makefile
src/plugins/pgpmime/Makefile
diff --git a/src/plugins/perl/Makefile.am b/src/plugins/perl/Makefile.am
@@ -1,3 +1,5 @@
+SUBDIRS = tools
+
plugindir = $(pkglibdir)/plugins
if BUILD_PERL_PLUGIN
@@ -26,3 +28,6 @@ INCLUDES = \
-I$(top_srcdir)/src/common \
-I$(top_builddir)/src/common \
-I$(top_srcdir)/src/gtk
+
+EXTRA_DIST = cm_perl.pod
+
diff --git a/src/plugins/perl/cm_perl.pod b/src/plugins/perl/cm_perl.pod
@@ -0,0 +1,768 @@
+=head1 NAME
+
+cm_perl -- A Perl Plugin for Claws Mail
+
+
+=head1 DESCRIPTION
+
+This plugin provides an extended filtering engine for the email
+client Claws Mail. It allows for the use of full Perl power
+in email filters.
+
+=head1 QUICK START
+
+To get started, you can use the B<matcherrc2perlfilter.pl> script
+in the B<tools>-directory to translate your old filtering rules to
+Perl. Simply execute the script and follow the instructions.
+(note that with recent versions of Claws Mail, this script might not
+work due to upstream syntax changes. This will get updated in the
+future. Send me an email if you have problems getting started).
+
+However, you might want to consider reading the rest of this
+manual and rewriting your rules if you choose to use the plugin,
+since the Perl code produced by this script is not exactly
+pretty.
+
+Don't speak Perl? No problem, L<"perldoc perlintro"|perlintro>
+should give you enough information to do fancy stuff.
+
+=head1 USAGE
+
+The Perl plugin expects a Perl script file called B<perl_filter>
+in Claws Mail' config directory (usually $HOME/.claws-mail --
+try `claws-mail --config-dir' if you're unsure). If that file
+doesn't exist on plugin start, an empty one is created. This
+file, which doesn't need to start with a sha-bang (!#/bin/perl),
+holds the Perl instructions for your email filters. To encourage
+some good manners, the code is executed in a C<use strict;>
+environment.
+
+Both Claws Mail' filtering B<conditions> and B<actions> are
+mapped to Perl functions with corresponding names, wherever this
+is possible.
+
+=head1 FUNCTION LISTING
+
+For a detailed function description, see section L</"FUNCTION
+DESCRIPTIONS">, below.
+
+=over 4
+
+=item Standard Filtering Conditions
+
+ all, marked, unread, deleted, new, replied,
+ forwarded, locked, ignore_thread, colorlabel,
+ match, matchcase, regexp, S<regexpcase, test,
+ size_greater, size_smaller, size_equal,
+ score_greater, score_lower, score_equal, age_greater,
+ age_lower, partial, tagged
+
+=item Standard Filtering Actions
+
+ mark, unmark, dele, mark_as_unread, mark_as_read,
+ lock, unlock, move, copy, color, execute,
+ hide, set_score, change_score, stop, forward,
+ forward_as_attachment, redirect, set_tag, unset_tag,
+ clear_tags
+
+=item Fun stuff
+
+ header, body, filepath, extract_addresses,
+ move_to_trash, abort, addr_in_addressbook,
+ from_in_addressbook, get_attribute_value, SA_is_spam,
+ exit, manual, make_sure_folder_exists,
+ filter_log, filter_log_verbosity,
+ make_sure_tag_exists
+
+=back
+
+=head1 FUNCTION DESCRIPTIONS
+
+In general, after the filtering invoked by the Perl script, the
+mail is passed on to Claws' internal filtering engine, I<unless>
+a B<final> rule was hit. Final rules stop not only the Perl
+filtering script at the point of their occurence, but also
+prevent processing that email by Claws' internal filtering engine
+(this might sound confusing, but you are already familiar with
+that concept from standard filters: After an email was
+e.g. I<move>d, the following rules don't apply anymore).
+
+Also, be careful with the way you quote. In particular, remember
+that the @-sign has a special meaning in Perl, and gets
+interpolated inside double quotes. See L<perlop/"Quote and
+Quote-like Operators"> to learn more about quoting and
+interpolation.
+
+
+=head2 Standard Filtering Conditions
+
+=over 8
+
+=item all
+
+Returns a true value. Available for completness only.
+
+=item marked
+
+Returns a true value if the marked flag is set, false otherwise.
+
+=item unread
+
+Returns a true value if the unread flag is set, false otherwise.
+
+=item deleted
+
+Returns a true value if the deleted flag is set, false otherwise.
+
+=item new
+
+Returns a true value if the new flag is set, false otherwise.
+
+=item replied
+
+Returns a true value if the replied flag is set, false otherwise.
+
+=item forwarded
+
+Returns a true value if the forwarded flag is set, false otherwise.
+
+=item locked
+
+Returns a true value if the locked flag is set, false otherwise.
+
+=item ignore_thread
+
+Returns a true value if the "Ignore Thread" flag is set, false otherwise.
+
+=item colorlabel COLOR
+
+=item colorlabel
+
+Returns a true value if message has the color COLOR. COLOR can be
+either a numeric value between 0 and 7 (with colors corresponding
+to the internal filtering engine), or the english color name as
+it is introduced in the filtering dialog (that is, one of: none,
+orange, red, pink, sky blue, blue, green or brown, while upper
+and lower case letters make no difference). If COLOR is omitted,
+0 (none) is assumed.
+
+=item size_greater SIZE
+
+Returns a true value if message size is greater than SIZE, false otherwise.
+
+=item size_smaller SIZE
+
+Returns a true value if message size is smaller than SIZE, false otherwise.
+
+=item size_equal SIZE
+
+Returns a true value if message size is equal to SIZE, false otherwise.
+
+=item score_greater SCORE
+
+Returns a true value if message score is greater than SCORE, false otherwise.
+
+=item score_lower SCORE
+
+Returns a true value if message score is lower than SCORE, false otherwise.
+
+=item score_equal SCORE
+
+Returns a true value if message score is equal to SCORE, false otherwise.
+
+=item age_greater AGE
+
+Returns a true value if message age is greater than AGE, false otherwise.
+
+=item age_lower AGE
+
+Returns a true value if message age is lower than AGE, false otherwise.
+
+=item partial
+
+Returns a true value if message has only partially been
+downloaded, false otherwise.
+
+=item tagged
+
+Returns a true value if the messages has one or more tags.
+
+=item test
+
+Corresponds the 'test' internal filtering rule. In particular, it
+accepts the same symbols, namely:
+
+=over
+
+=item %%
+
+%
+
+=item %s
+
+Subject
+
+=item %f
+
+From
+
+=item %t
+
+To
+
+=item %c
+
+Cc
+
+=item %d
+
+Date
+
+=item %i
+
+Message-ID
+
+=item %n
+
+Newsgroups
+
+=item %r
+
+References
+
+=item %F
+
+Filename -- should not be modified
+
+=back
+
+=item match WHERE WHAT
+
+=item matchcase WHERE WHAT
+
+=item regexp WHERE WHAT
+
+=item regexpcase WHERE WHAT
+
+The matching functions have a special syntax. The first argument
+is either any of to_or_cc, body_part, headers_part, message, to,
+from, subject, cc, newsgroups, inreplyto, references, or tag (those
+strings may or may not be quoted), the patter matching works on
+that area. If it is any other string (which must then be quoted),
+this string is taken to be the name of a header field.
+
+The second argument is the string to look for. For match,
+matchcase, regexp and regexpcase we have case sensitive normal
+matching, case insensitive normal matching, case sensitive
+regular expression matching and case insensitive regular
+expression pattern matching, respectively.
+
+The functions return true if the pattern was found, false
+otherwise.
+
+Just as with the built-in filtering engine, the message body is
+searched and provided as is - no character-set analysis is
+done. Likewise, no HTML-tags are stripped. It should be possible
+to use external modules or programs for these tasks though. If
+you're doing that, drop me a message with your experiences.
+
+With Perl having its strenghts in pattern matching, using Perl's
+builtin operators are usually a better option than using these
+functions.
+
+=back
+
+=head2 Standard Filtering Actions
+
+The actions return a true value upon success, and 'undef' when an
+error occured. I<Final> message rules are indicated. (See above
+for a sketch what a final rule is)
+
+=over 8
+
+=item mark
+
+Mark the message.
+
+=item unmark
+
+Unmark the message.
+
+=item dele
+
+Delete the message. Note the name change of Claws Mail'
+"delete" to "dele". This is because "delete" is one of Perl's
+builtin commands which cannot be redefined (if it can, tell me
+how).
+
+This is a I<final> rule.
+
+=item mark_as_read
+
+Mark the message as read
+
+=item mark_as_unread
+
+Mark the message as unread
+
+=item lock
+
+Lock the message
+
+=item unlock
+
+Remove the message lock
+
+=item move DESTINATION
+
+Move the message to folder DESTINATION. The folder notation is
+the same that Claws Mail uses. You can copy & paste from the
+move dialog of the normal filtering, until you get a feeling for
+the notation.
+
+This is a I<final> rule.
+
+=item copy DESTINATION
+
+Copy the message to folder DESTINATION. The folder notation is
+the same that Claws Mail uses. You can copy & paste from the
+move dialog of the normal filtering, until you get a feeling for
+the notation.
+
+=item execute COMMAND
+
+This is the same as the test - rule from section L</"Standard
+Filtering Conditions"> execpt that it always returns a true
+value.
+
+=item hide
+
+Hide the message
+
+=item set_score SCORE
+
+Set message score to SCORE
+
+=item change_score SCORE
+
+Change message score by SCORE
+
+=item stop
+
+Stop Perl script at this point. Note that this is B<not> a final
+rule, meaning that the email gets passed on to the internal
+filtering engine. See "abort" below if you don't want that.
+
+=item forward ACCOUNT, EMAIL
+
+Forward the message to email address EMAIL, using the account ID
+ACCOUNT as sender account. So far, you have to create a rule
+in the normal filtering engine to find out that number.
+
+=item forward_as_attachment, ACCOUNT EMAIL
+
+Forward the message to email address EMAIL in an attachment,
+using the account ID ACCOUNT as sender account. So far, you
+have to create a rule in the normal filtering engine to find out
+that number.
+
+=item redirect ACCOUNT, EMAIL
+
+Redirect the message to EMAIL, using the account ID ACCOUNT as
+sender account. So far, you have to create a rule in the normal
+filtering engine to find out that number.
+
+=item set_tag TAG
+
+Apply tag TAG. TAG must exist.
+
+=item unset_tag TAG
+
+Unset tag TAG.
+
+=item clear_tags
+
+Clear all tags.
+
+=back
+
+=head2 Fun stuff
+
+=head3 Functions
+
+=over 8
+
+=item header ARG
+
+=item header
+
+If ARG is not given, returns a list of all header field names of
+the mail.
+
+If ARG is given, returns 'undef' if the header field ARG does not
+exist in the email. Otherwise, it returns
+
+=over
+
+=item in scalar context
+
+The value of the header field ARG.
+
+=item in list context
+
+A list of all available header field values. This is useful if a
+header field occurs more than once in an email (eg the Received -
+header).
+
+=back
+
+The header field "References" forms a special case. In a scalar context,
+it returns the first reference. In a list context, it returns a list of
+all references.
+
+=item body
+
+Returns the email body in a scalar.
+
+=item filepath
+
+Returns the file and path of the email that is currently filtered
+(corresponds to the %F arguemnt in the 'test' rule).
+
+=item extract_addresses
+
+Extracts email addresses from a string and gives back a list of
+addresses found. Currently an email address is found using the
+regular expression '[-.+\w]+\@[-.+\w]+'. This will not find all
+valid email addresses. Feel free to send me a better regexp.
+
+=item move_to_trash
+
+Move the email message to default trash folder.
+
+This is a I<final> rule.
+
+=item abort
+
+Stop Perl script at this point.
+
+In contrast to 'stop', this is a I<final> rule.
+
+=item addr_in_addressbook EMAIL, ADDRESSBOOK
+
+=item addr_in_addressbook EMAIL
+
+Returns a true value if the email address EMAIL is in the addressbook
+with the name ADDRESSBOOK. If ADDRESSBOOK is not given, returns
+true if the email address is in any addressbook.
+
+=item from_in_addressbook ADDRESSBOOK
+
+=item from_in_addressbook
+
+Checks if the email address found in the From-header is in
+addressbook ADDRESSBOOK (or any, if omitted). It is implemented
+as
+
+ my ($from) = extract_addresses(header("from"));
+ return 0 unless $from;
+ return addr_in_addressbook($from,@_);
+
+so the same restrictions as to extract_addresses apply.
+
+=item get_attribute_value EMAIL, ATTRIBUTE, ADDRESSBOOK
+
+=item get_attribute_value EMAIL, ATTRIBUTE
+
+Looks through the addressbook ADDRESSBOOK (or all addressbooks,
+if omitted) for a contact with the an email address EMAIL. If
+found, the function checks if this contact has a user attribute
+with name ATTRIBUTE. It returns the value of this attribute, or
+an empty string if it was not found. As usual, 'undef' is
+returned if an error occured.
+
+=item SA_is_spam
+
+Is an alias to
+
+not test 'spamc -c < %F > /dev/null'
+
+=item exit
+
+Has been redefined to be an alias to 'stop'. You shouldn't use
+Perl's own 'exit' command, since it would exit Claws Mail.
+
+=item manual
+
+Returns a true value if the filter script was invoked manually,
+that is, via the Tools menu.
+
+=item make_sure_folder_exists IDENTIFIER
+
+Returns a true value if the folder with id IDENTIFIER (e.g. #mh/Mail/foo/bar)
+exists or could be created.
+
+=item make_sure_tag_exists TAG
+
+Returns a true value if the tag TAG exists or could be created.
+
+=item filter_log SECTION, TEXT
+
+=item filter_log TEXT
+
+Writes TEXT to the filter logfile. SECTION can be any of
+
+=over
+
+=item *
+
+"LOG_MANUAL"
+
+=item *
+
+"LOG_MATCH"
+
+=item *
+
+"LOG_ACTION"
+
+=back
+
+If the SECTION is omitted, "LOG_MANUAL" is assumed.
+
+=item filter_log_verbosity VERBOSITY
+
+=item filter_log_verbosity
+
+Changes the filter log verbosity for the current mail. VERBOSITY
+must be any of
+
+=over
+
+=item *
+
+0
+
+=item *
+
+1
+
+=item *
+
+2
+
+=item *
+
+3
+
+=back
+
+For the meaning of those numbers, read section L</"LOGGING">. If
+VERBOSITY is omitted, the filter logfile verbosity is not changed.
+
+This function returns the filter_log_verbosity number before the
+change (if any).
+
+=back
+
+=head3 Variables
+
+=over 8
+
+=item $permanent
+
+This scalar keeps its value between filtered mail messages. On
+plugin start, it is initialized to the empty string.
+
+=back
+
+=head1 LOGGING
+
+To keep track of what has been done to the mails while filtering,
+the plugin supports logging. Three verbosity levels are
+recognized:
+
+=over
+
+=item 0
+
+logging disabled
+
+=item 1
+
+log only manual messages, that is, messages introduced by the
+C<filter_log> command in filter scripts
+
+=item 2
+
+log manual messages and filter actions
+
+=item 3
+
+log manual messages, filter actions and filter matches
+
+=back
+
+The messages are logged in Claws Mail' log window.
+The default log level is 2. Log level 3 is not
+recommended, because the matcher functions log a message if they
+succeeded, and thus, if you have negative checks, you'll get
+confusing entries. If you want to keep track of matching, do it
+manually, using C<filter_log>, or do it by temporary enabling
+matcher logging using C<filter_log_verbosity>.
+
+The first time you unload this plugin (or shut down
+Claws Mail), a section called B<[PerlPlugin]> will be created
+in Claws Mail' configuration file B<clawsrc>, containing
+one variable:
+
+ * filter_log_verbosity
+
+If you want to change the default behaviour, you can edit this
+line. Make sure Claws Mail is not running while you do
+this.
+
+It will be possible to access these setting via the GUI, as soon
+as I find the time to write a corresponding GTK plugin, or
+somebody else is interested in contributing that.
+
+=head1 EXAMPLE
+
+This section lists a small example of a Perl script file. I'm
+sure you get the idea..
+
+ #-8<----------------------------------------------------
+ # -*- perl -*-
+
+ # local functions
+
+ # Learn ham messages, and move them to specified folder. This is
+ # useful for making sure a bayes filter sees ham as well.
+ sub learn_and_move {
+ execute('put command to learn ham here');
+ move(@_);
+ }
+
+ # Two-stage spam filter. Every email that scores higher than 15
+ # on SpamAssassin gets moved into the default trash folder.
+ # All mails lower than that, but higher than SpamAssassin's
+ # 'required_hits' go into #mh/mail/Spam.
+ sub spamcheck {
+ my $surely_spam = 15;
+ my $filepath = filepath;
+ my $spamc = `spamc -c < $filepath`;
+ my ($value,$threshold) = ($spamc =~ m|([-.,0-9]+)/([-.,0-9]+)|);
+ if($value >= $surely_spam) {
+ mark_as_read;
+ move_to_trash;
+ }
+ if($value >= $threshold) {mark_as_read; move '#mh/mail/Spam';}
+ }
+
+ # Perl script execution starts here.
+
+ # Some specific sorting
+ learn_and_move '#mh/mail/MailLists/Claws Mail/user'
+ if matchcase('sender','claws-mail-users-admin@lists.sourceforge.net');
+ learn_and_move '#mh/mail/MailLists/Sylpheed'
+ if matchcase('list-id','sylpheed.good-day.net');
+
+ # Implement imcomming folders using addressbook
+ # attributes. Target folders for specific email addresses are
+ # stored directly in the addressbook. This way, if an email
+ # address changes, we only have to update the addressbook, not
+ # the filter rules! Besides that, we can greatly unclutter the
+ # filter script.
+
+ # get the email address in the from header
+ my $fromheader = header "from";
+ my ($from) = extract_addresses $fromheader;
+
+ # check if this email address has an associated attribute
+ # called "incomming_folder". If if has, the value of this
+ # attribute is supposed to be the target folder.
+ my $value = get_attribute_value $from, "incomming_folder";
+ learn_and_move($value) if $value;
+
+ # An example of a whitelist: If the from-address is in my
+ # "office" addressbook, move the mail to folder #mh/mail/office
+ learn_and_move '#mh/mail/office' if from_in_addressbook("office");
+
+ # If the from-address is in any other addressbook, move the
+ # mail to folder #mh/mail/inbox/known
+ learn_and_move '#mh/mail/inbox/known' if from_in_addressbook;
+
+ # Feed the remaining mails through SpamAssassin.
+ spamcheck;
+
+ # mails that make it to the end of the script are passed on to
+ # the internal filtering engine. If the internal rules don't say
+ # otherwise, the mails end up in the default inbox.
+ #-8<----------------------------------------------------
+
+
+=head1 BUGS
+
+=over 4
+
+=item *
+
+Do B<not> use this plugin together with other filtering plugins,
+especially the B<Spamassassin> and B<ClamAV> plugins. They are
+registered on the same hook and the order in which the plugins
+are executed is not guaranteed.
+
+=item *
+
+The filter script is not (yet) updated automatically when a
+folder gets renamed. The same applies for folder names in
+addressbook user attributes.
+
+=item *
+
+This plugin has only be tested with POP3 accounts. If you have
+experiences with IMAP or newsgroup accounts, drop me a message.
+
+=item *
+
+Warning during compile time:
+
+ *** Warning: Linking the shared library perl_plugin.la against the
+ *** static library
+ /usr/lib/perl5/5.8.3/i586-linux-thread-multi/auto/DynaLoader/DynaLoader.a
+ is not portable!
+
+Ideas to solve this one are welcome :-)
+
+=back
+
+Please report comments, suggestions and bugreports to the address
+given in the L</AUTHOR> section of this document.
+
+
+=head1 LICENSE and (no) WARRANTY
+
+This program 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, see http://www.gnu.org/licenses/.
+
+=head1 SEE ALSO
+
+claws-mail(1), perl(1)
+
+
+=head1 AUTHOR
+
+Holger Berndt <berndth@gmx.de>
+
+=cut
diff --git a/src/plugins/perl/tools/.cvsignore b/src/plugins/perl/tools/.cvsignore
@@ -0,0 +1,2 @@
+Makefile
+Makefile.in
diff --git a/src/plugins/perl/tools/Makefile.am b/src/plugins/perl/tools/Makefile.am
@@ -0,0 +1,10 @@
+EXTRA_TOOLS = \
+ matcherrc2perlfilter.pl
+
+EXTRA_DIST = \
+ $(EXTRA_TOOLS)
+
+MAKE_EXE = chmod u+x $(EXTRA_TOOLS)
+
+all-local:
+ $(MAKE_EXE)
+\ No newline at end of file
diff --git a/src/plugins/perl/tools/insert_perl.pl b/src/plugins/perl/tools/insert_perl.pl
@@ -0,0 +1,40 @@
+#!/usr/bin/perl -w
+# parameters: <cmd> what perl-code c-code
+#
+use strict;
+use File::Copy;
+
+die "Wrong parameters\n" if $#ARGV != 2;
+
+my ($what,$perl_code,$c_code) = @ARGV;
+
+copy($c_code,$c_code.".bak") or die "Copy failed: $!";
+
+open FH,"<",$perl_code or die "Cannot open $perl_code: $!";
+my @perl_code = <FH>; close FH;
+
+foreach (@perl_code) {
+ s|\\|\\\\|g;
+ s|\"|\\\"|g;
+ s|(.*)|\"$1\\n\"|;
+}
+
+open FH,"<",$c_code or die "Cannot open $c_code: $!";
+my @c_code = <FH>; close FH;
+
+my (@c_code_new,$line);
+
+while($line = shift @c_code) {
+ if($line =~ /const\s+char\s+$what\s*\[\s*\]\s*=\s*\{/) {
+ push @c_code_new,$line;
+ push @c_code_new,$_ foreach (@perl_code);
+ $line = shift @c_code while(not ($line =~ m/^\s*\}\s*;\s*$/));
+ push @c_code_new,$line;
+ }
+ else {
+ push @c_code_new,$line;
+ }
+}
+
+open FH,">",$c_code or die "Cannot open $c_code: $!";
+print FH "$_" foreach (@c_code_new);
diff --git a/src/plugins/perl/tools/matcherrc2perlfilter.pl b/src/plugins/perl/tools/matcherrc2perlfilter.pl
@@ -0,0 +1,203 @@
+#!/usr/bin/perl -w
+#
+## script purpose : convert matcherrc filtering rules into
+## perl_filter rules
+#
+# This conversion-tool doesn't produce nice Perl code and is just
+# intended to get you started. If you choose to use the Perl plugin,
+# consider rewriting your rules.
+#
+# Copyright (C) 2004 Holger Berndt
+#
+#
+# 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, see <http://www.gnu.org/licenses/>.
+
+use strict;
+
+our $warnings = 0;
+our $lines = 0;
+our $tokens = 0;
+
+my $home_dir = $ENV{"HOME"}; $home_dir ||= ".";
+my $sylph_dir = `claws-mail --config-dir`;
+my $matcherrc = "matcherrc";
+my $perlfilter = "perl_filter";
+my $dirsep = "/";
+
+chomp($sylph_dir); $sylph_dir =~ s/.*\n(.*)$/$1/;
+my $inpath = $home_dir.$dirsep.$sylph_dir.$dirsep.$matcherrc;
+my $outpath = $home_dir.$dirsep.$sylph_dir.$dirsep.$perlfilter;
+open IN, $inpath or die "Cannot open $inpath: $!";
+open OUT,">>",$outpath or die "Cannot open $outpath: $!";
+
+print "Filtering rules are read from `$inpath', converted to Perl\n";
+print "syntax and appended to `$outpath'\n";
+print "`$inpath' is not changed, so you might want to make a backup\n";
+print "copy of it and then remove your former filtering rules\n";
+print "---\n";
+my $date = `date`;
+chomp($date);
+print OUT "### Begin: Rules converted by matcherrc2perlfilter.pl $date ###\n";
+while(my $line = <IN>) {
+ $line =~ s/^\s*(.*)\s*$/$1/;
+ if($line =~ /^\[filtering\]$/i) {
+ while($line = <IN>) {
+ $line =~ s/^\s*(.*)\s*$/$1/;
+ next if $line =~ /^$/;
+ if($line =~ /^\[(.+)\]$/) {
+ last unless ($1 =~ /filtering/i);
+ }
+ my @fields = splitline($line);
+ $lines++;
+ convert(@fields);
+ }
+ }
+}
+print "---\n" if $warnings;
+print "Finished conversion of $lines rules with $warnings warnings.\n";
+print OUT "### End: Rules converted by matcherrc2perlfilter.pl $date ###\n";
+
+# convert a rule
+sub convert {
+ my $act = 0;
+ my $output="(";
+ while(my $token = shift) {
+ $tokens++;
+ if($token eq "&") {
+ $token = shift;
+ }
+ elsif($token eq "|") {
+ $output =~ s/&& $/\|\| /;
+ $token = shift;
+ }
+ elsif($tokens != 1 and $act == 0) {
+ $act = 1;
+ if($output =~ / (&&|\|\|) $/) {
+ $output =~ s/ (&&|\|\|) $/\) $1 /;
+ }
+ else {
+ $output .= ")";
+ }
+ }
+
+ if($token eq "~") {
+ $output .= "!";
+ $token = shift;
+ }
+
+ if($token eq "all" or
+ $token eq "marked" or
+ $token eq "deleted" or
+ $token eq "replied" or
+ $token eq "forwarded" or
+ $token eq "locked" or
+ $token eq "unread" or
+ $token eq "new" or
+ $token eq "partial" or
+ $token eq "ignore_thread" or
+ $token eq "mark" or
+ $token eq "unmark" or
+ $token eq "lock" or
+ $token eq "unlock" or
+ $token eq "stop" or
+ $token eq "hide" or
+ $token eq "mark_as_read" or
+ $token eq "mark_as_unread") {
+ $output .= qq|($token) && |;
+ }
+ elsif($token eq "delete") {
+ $output .= qq|(dele) && |;
+ }
+ elsif($token eq "subject" or
+ $token eq "from" or
+ $token eq "to" or
+ $token eq "cc" or
+ $token eq "to_or_cc" or
+ $token eq "newsgroups" or
+ $token eq "inreplyto" or
+ $token eq "references" or
+ $token eq "headers_part" or
+ $token eq "body_part" or
+ $token eq "message") {
+ my $match = shift;
+ my $what = shift;
+ $what =~ s/\\"/"/g;$what =~ s/'/\\'/g;
+ $what =~ s/^"(.*)"$/'$1'/;
+ $output .= qq|($match($token,$what)) && |;
+ }
+ elsif($token eq "age_greater" or
+ $token eq "age_lower" or
+ $token eq "colorlabel" or
+ $token eq "score_greater" or
+ $token eq "score_lower" or
+ $token eq "score_equal" or
+ $token eq "size_greater" or
+ $token eq "size_smaller" or
+ $token eq "size_equal" or
+ $token eq "move" or
+ $token eq "copy" or
+ $token eq "execute" or
+ $token eq "color" or
+ $token eq "test" or
+ $token eq "change_score" or
+ $token eq "set_score") {
+ my $arg = shift;
+ $arg =~ s/\\"/"/g;$arg =~ s/'/\\'/g;
+ $arg =~ s/^"(.*)"$/'$1'/;
+ $output .= qq|($token($arg)) && |;
+ }
+ elsif($token eq "header") {
+ my $headername = shift;
+ $headername =~ s/\\"/"/g;$headername =~ s/'/\\'/g;
+ $headername =~ s/^"(.*)"$/'$1'/;
+ my $match = shift;
+ my $what = shift;
+ $what =~ s/\\"/"/g;$what =~ s/'/\\'/g;
+ $what =~ s/^"(.*)"$/'$1'/;
+ $output .= qq|($match($headername,$what)) && |;
+ }
+ elsif($token eq "stop") {
+ $output .= qq|(return) && |;
+ }
+ else {
+ print STDERR "WARNING: unknown token in $inpath ignored: $token\n";
+ $warnings++;
+ }
+ }
+ $output =~ s| && $|;\n|;
+ print OUT $output;
+ $tokens = 0;
+}
+
+# split the input line
+sub splitline {
+ my @fields;
+ my $line = shift;
+ while($line) {
+ $line =~ s/^\s+//;
+ if($line =~ m#^"#) {
+ $line =~ s#^(".*?[^\\]")##;
+ push @fields,$1;
+ }
+ elsif($line =~ /^~/) {
+ $line =~ s#^(~)##;
+ push @fields,$1;
+ }
+ else {
+ $line =~ s#^(\S+)##;
+ push @fields,$1;
+ }
+ }
+ return @fields;
+}
