[Commits] perl_plugin.c 1.19.2.40 1.19.2.41
holger at claws-mail.org
holger at claws-mail.org
Sat Dec 29 04:15:56 CET 2012
Update of /home/claws-mail/plugins/perl/src
In directory srv:/tmp/cvs-serv21577/src
Modified Files:
Tag: gtk2
perl_plugin.c
Log Message:
2012-12-29 [holger] 0.9.20cvs3
* cm_perl.pod
* src/perl_plugin.c
Add tag matcher conditions analogous to the builtin filtering engine
Index: perl_plugin.c
===================================================================
RCS file: /home/claws-mail/plugins/perl/src/perl_plugin.c,v
retrieving revision 1.19.2.40
retrieving revision 1.19.2.41
diff -u -d -r1.19.2.40 -r1.19.2.41
--- perl_plugin.c 29 Dec 2012 01:51:02 -0000 1.19.2.40
+++ perl_plugin.c 29 Dec 2012 03:15:54 -0000 1.19.2.41
@@ -155,9 +155,9 @@
if(filter_log_verbosity >= type) {
if(!wrote_filter_log_head) {
log_message(LOG_PROTOCOL, "From: %s || Subject: %s || Message-ID: %s\n",
- msginfo->from ? msginfo->from : "<no From header>",
- msginfo->subject ? msginfo->subject : "<no Subject header>",
- msginfo->msgid ? msginfo->msgid : "<no message id>");
+ msginfo->from ? msginfo->from : "<no From header>",
+ msginfo->subject ? msginfo->subject : "<no Subject header>",
+ msginfo->msgid ? msginfo->msgid : "<no message id>");
wrote_filter_log_head = TRUE;
}
switch(type) {
@@ -345,22 +345,22 @@
/* Process each E-Mail address */
nodeM = person->listEMail;
while(nodeM) {
- ItemEMail *email = nodeM->data;
+ ItemEMail *email = nodeM->data;
- ae = g_new0(PerlPluginAttributeEntry,1);
- g_return_val_if_fail(ae != NULL, -1);
-
- if(email->address != NULL) ae->address = g_strdup(email->address);
- else ae->address = NULL;
- if(attrib->value != NULL) ae->value = g_strdup(attrib->value);
- else ae->value = NULL;
- if(bookname != NULL) ae->bookname = g_strdup(bookname);
- else ae->bookname = NULL;
-
- tl = (PerlPluginTimedSList *) g_hash_table_lookup(attribute_hash,attribute_key);
- tl->g_slist = g_slist_prepend(tl->g_slist,ae);
+ ae = g_new0(PerlPluginAttributeEntry,1);
+ g_return_val_if_fail(ae != NULL, -1);
- nodeM = g_list_next(nodeM);
+ if(email->address != NULL) ae->address = g_strdup(email->address);
+ else ae->address = NULL;
+ if(attrib->value != NULL) ae->value = g_strdup(attrib->value);
+ else ae->value = NULL;
+ if(bookname != NULL) ae->bookname = g_strdup(bookname);
+ else ae->bookname = NULL;
+
+ tl = (PerlPluginTimedSList *) g_hash_table_lookup(attribute_hash,attribute_key);
+ tl->g_slist = g_slist_prepend(tl->g_slist,ae);
+
+ nodeM = g_list_next(nodeM);
}
}
nodeA = g_list_next(nodeA);
@@ -383,14 +383,14 @@
if(tl->g_slist != NULL) {
walk = tl->g_slist;
for(; walk != NULL; walk = g_slist_next(walk)) {
- PerlPluginAttributeEntry *ae = (PerlPluginAttributeEntry *) walk->data;
- if(ae != NULL) {
- if(ae->address != NULL) g_free(ae->address);
- if(ae->value != NULL) g_free(ae->value);
- if(ae->bookname != NULL) g_free(ae->bookname);
- g_free(ae);
- ae = NULL;
- }
+ PerlPluginAttributeEntry *ae = (PerlPluginAttributeEntry *) walk->data;
+ if(ae != NULL) {
+ if(ae->address != NULL) g_free(ae->address);
+ if(ae->value != NULL) g_free(ae->value);
+ if(ae->bookname != NULL) g_free(ae->bookname);
+ g_free(ae);
+ ae = NULL;
+ }
}
g_slist_free(tl->g_slist);
tl->g_slist = NULL;
@@ -494,9 +494,9 @@
b = g_utf8_strdown(email, -1);
if(!g_utf8_collate(a, b)) {
if((bookname == NULL) ||
- ((ae->bookname != NULL) && !strcmp(bookname,ae->bookname))) {
+ ((ae->bookname != NULL) && !strcmp(bookname,ae->bookname))) {
g_free(a); g_free(b);
- return ae->value;
+ return ae->value;
}
}
g_free(a); g_free(b);
@@ -746,10 +746,10 @@
/* flags: 1 marked
* 2 unread
* 3 deleted
- * 4 new
- * 5 replied
- * 6 forwarded
- * 7 locked
+ * 4 new
+ * 5 replied
+ * 6 forwarded
+ * 7 locked
* 8 ignore thread
*/
@@ -885,6 +885,46 @@
XSRETURN_NO;
}
+/* ClawsMail::C::tagged() */
+static XS(XS_ClawsMail_tagged)
+{
+ dXSARGS;
+ if(items != 0) {
+ g_warning("Perl Plugin: Wrong number of arguments to ClawsMail::C::tagged");
+ XSRETURN_UNDEF;
+ }
+
+ return msginfo->tags ? XSRETURN_YES : XSRETURN_NO;
+}
+
+/* ClawsMail::C::get_tags() */
+static XS(XS_ClawsMail_get_tags)
+{
+ guint iTag;
+ guint num_tags;
+ GSList *walk;
+
+ dXSARGS;
+ if(items != 0) {
+ g_warning("Perl Plugin: Wrong number of arguments to ClawsMail::C::get_tags");
+ XSRETURN_UNDEF;
+ }
+
+ num_tags = g_slist_length(msginfo->tags);
+
+ EXTEND(SP, num_tags);
+ iTag = 0;
+ for(walk = msginfo->tags; walk != NULL; walk = g_slist_next(walk)) {
+ const char *tag_str;
+ tag_str = tags_get_tag(GPOINTER_TO_INT(walk->data));
+ XST_mPV(iTag++, tag_str ? tag_str: "");
+ }
+
+ XSRETURN(num_tags);
+}
+
+
+
/* ClawsMail::C::set_tag(char*) */
static XS(XS_ClawsMail_set_tag)
{
@@ -1123,7 +1163,7 @@
if (!dest_folder) {
g_warning("Perl Plugin: move: folder not found '%s'",
- targetfolder ? targetfolder :"");
+ targetfolder ? targetfolder :"");
XSRETURN_UNDEF;
}
if (folder_item_move_msg(dest_folder, msginfo) == -1) {
@@ -1154,7 +1194,7 @@
if (!dest_folder) {
g_warning("Perl Plugin: copy: folder not found '%s'",
- targetfolder ? targetfolder :"");
+ targetfolder ? targetfolder :"");
XSRETURN_UNDEF;
}
if (folder_item_copy_msg(dest_folder, msginfo) == -1) {
@@ -1285,19 +1325,19 @@
account = account_find_from_id(account_id);
compose = compose_forward(account, msginfo,
- flag == 1 ? FALSE : TRUE,
- NULL, TRUE, TRUE);
+ flag == 1 ? FALSE : TRUE,
+ NULL, TRUE, TRUE);
compose_entry_append(compose, dest,
- compose->account->protocol == A_NNTP ?
- COMPOSE_NEWSGROUPS : COMPOSE_TO, PREF_NONE);
+ compose->account->protocol == A_NNTP ?
+ COMPOSE_NEWSGROUPS : COMPOSE_TO, PREF_NONE);
val = compose_send(compose);
if(val == 0) {
logtext = g_strdup_printf("forward%s to %s",
- flag==2 ? " as attachment" : "",
- dest ? dest : "<unknown destination>");
+ flag==2 ? " as attachment" : "",
+ dest ? dest : "<unknown destination>");
filter_log_write(LOG_ACTION, logtext);
g_free(logtext);
@@ -1338,7 +1378,7 @@
if(val == 0) {
logtext = g_strdup_printf("redirect to %s",
- dest ? dest : "<unknown destination>");
+ dest ? dest : "<unknown destination>");
filter_log_write(LOG_ACTION, logtext);
g_free(logtext);
@@ -1466,7 +1506,7 @@
dXSARGS;
if(items != 1 && items != 0) {
g_warning("Perl Plugin: Wrong number of arguments to "
- "ClawsMail::C::filter_log_verbosity");
+ "ClawsMail::C::filter_log_verbosity");
XSRETURN_UNDEF;
}
retval = filter_log_verbosity;
@@ -1487,6 +1527,7 @@
newXS("ClawsMail::C::check_flag", XS_ClawsMail_check_flag, "ClawsMail::C");
newXS("ClawsMail::C::age_greater", XS_ClawsMail_age_greater, "ClawsMail::C");
newXS("ClawsMail::C::age_lower", XS_ClawsMail_age_lower, "ClawsMail::C");
+ newXS("ClawsMail::C::tagged", XS_ClawsMail_tagged, "ClawsMail::C");
newXS("ClawsMail::C::set_flag", XS_ClawsMail_set_flag, "ClawsMail::C");
newXS("ClawsMail::C::unset_flag", XS_ClawsMail_unset_flag, "ClawsMail::C");
newXS("ClawsMail::C::delete", XS_ClawsMail_delete, "ClawsMail::C");
@@ -1503,25 +1544,26 @@
newXS("ClawsMail::C::unset_tag", XS_ClawsMail_unset_tag, "ClawsMail::C");
newXS("ClawsMail::C::clear_tags", XS_ClawsMail_clear_tags, "ClawsMail::C");
newXS("ClawsMail::C::make_sure_folder_exists",
- XS_ClawsMail_make_sure_folder_exists,"ClawsMail::C");
+ XS_ClawsMail_make_sure_folder_exists,"ClawsMail::C");
newXS("ClawsMail::C::make_sure_tag_exists", XS_ClawsMail_make_sure_tag_exists,"ClawsMail::C");
+ newXS("ClawsMail::C::get_tags", XS_ClawsMail_get_tags,"ClawsMail::C");
newXS("ClawsMail::C::addr_in_addressbook",
- XS_ClawsMail_addr_in_addressbook,"ClawsMail::C");
+ XS_ClawsMail_addr_in_addressbook,"ClawsMail::C");
newXS("ClawsMail::C::open_mail_file",
- XS_ClawsMail_open_mail_file,"ClawsMail::C");
+ XS_ClawsMail_open_mail_file,"ClawsMail::C");
newXS("ClawsMail::C::close_mail_file",
- XS_ClawsMail_close_mail_file,"ClawsMail::C");
+ XS_ClawsMail_close_mail_file,"ClawsMail::C");
newXS("ClawsMail::C::get_next_header",
- XS_ClawsMail_get_next_header,"ClawsMail::C");
+ XS_ClawsMail_get_next_header,"ClawsMail::C");
newXS("ClawsMail::C::get_next_body_line",
- XS_ClawsMail_get_next_body_line,"ClawsMail::C");
+ XS_ClawsMail_get_next_body_line,"ClawsMail::C");
newXS("ClawsMail::C::move_to_trash",XS_ClawsMail_move_to_trash,"ClawsMail::C");
newXS("ClawsMail::C::abort", XS_ClawsMail_abort, "ClawsMail::C");
newXS("ClawsMail::C::get_attribute_value",
- XS_ClawsMail_get_attribute_value,"ClawsMail::C");
+ XS_ClawsMail_get_attribute_value,"ClawsMail::C");
newXS("ClawsMail::C::filter_log", XS_ClawsMail_filter_log, "ClawsMail::C");
newXS("ClawsMail::C::filter_log_verbosity",
- XS_ClawsMail_filter_log_verbosity, "ClawsMail::C");
+ XS_ClawsMail_filter_log_verbosity, "ClawsMail::C");
}
/*
@@ -1543,7 +1585,7 @@
STRLEN n_a;
call_argv("ClawsMail::Filter::Matcher::filter_init_",
- G_DISCARD | G_EVAL | G_NOARGS,noargs);
+ G_DISCARD | G_EVAL | G_NOARGS,noargs);
/* check $@ */
if(SvTRUE(ERRSV)) {
debug_print("%s", SvPV(ERRSV,n_a));
@@ -1552,7 +1594,7 @@
perlfilter = g_strconcat(get_rc_dir(), G_DIR_SEPARATOR_S, PERLFILTER, NULL);
args[0] = perlfilter;
call_argv("ClawsMail::Persistent::eval_file",
- G_DISCARD | G_EVAL, args);
+ G_DISCARD | G_EVAL, args);
g_free(perlfilter);
if(SvTRUE(ERRSV)) {
AlertValue val;
@@ -1563,8 +1605,8 @@
debug_print("%s", SvPV(ERRSV,n_a));
message = g_strdup_printf("Error processing Perl script file: "
- "(line numbers may not be valid)\n%s",
- SvPV(ERRSV,n_a));
+ "(line numbers may not be valid)\n%s",
+ SvPV(ERRSV,n_a));
val = alertpanel("Perl Plugin error",message,"Retry","Abort","Edit");
g_free(message);
@@ -1572,15 +1614,15 @@
/* Open PERLFILTER in an external editor */
perlfilter = g_strconcat(get_rc_dir(), G_DIR_SEPARATOR_S, PERLFILTER, NULL);
if (prefs_common_get_ext_editor_cmd() &&
- (pp = strchr(prefs_common_get_ext_editor_cmd(), '%')) &&
- *(pp + 1) == 's' && !strchr(pp + 2, '%')) {
- g_snprintf(buf, sizeof(buf), prefs_common_get_ext_editor_cmd(), perlfilter);
+ (pp = strchr(prefs_common_get_ext_editor_cmd(), '%')) &&
+ *(pp + 1) == 's' && !strchr(pp + 2, '%')) {
+ g_snprintf(buf, sizeof(buf), prefs_common_get_ext_editor_cmd(), perlfilter);
}
else {
- if (prefs_common_get_ext_editor_cmd())
- g_warning("Perl Plugin: External editor command-line is invalid: `%s'",
- prefs_common_get_ext_editor_cmd());
- g_snprintf(buf, sizeof(buf), "emacs %s", perlfilter);
+ if (prefs_common_get_ext_editor_cmd())
+ g_warning("Perl Plugin: External editor command-line is invalid: `%s'",
+ prefs_common_get_ext_editor_cmd());
+ g_snprintf(buf, sizeof(buf), "emacs %s", perlfilter);
}
g_free(perlfilter);
cmdline = strsplit_with_quote(buf, " ", 1024);
@@ -1628,27 +1670,27 @@
" my $package = valid_package_name($file);\n"
" my $mtime = -M $file;\n"
" if(!(defined $Cache{$package}{mtime} &&\n"
-" $Cache{$package}{mtime} <= $mtime)) {\n"
-" delete_package($package) if defined $Cache{$package}{mtime};\n"
-" local *FH;\n"
-" open FH, $file or die \"Failed to open '$file': $!\";\n"
-" local($/) = undef;\n"
-" my $sub = <FH>;\n"
-" close FH;\n"
-" #wrap the code into a subroutine inside our unique package\n"
-" my $eval = qq{package $package;\n"
-" use ClawsMail::Filter::Matcher;\n"
-" use ClawsMail::Filter::Action;\n"
-" use ClawsMail::Utils;\n"
-" sub handler { $sub; }};\n"
-" {\n"
-" # hide our variables within this block\n"
-" my($file,$mtime,$package,$sub);\n"
-" eval $eval;\n"
-" }\n"
-" die $@ if $@;\n"
-" #cache it unless we're cleaning out each time\n"
-" $Cache{$package}{mtime} = $mtime unless $delete;\n"
+" $Cache{$package}{mtime} <= $mtime)) {\n"
+" delete_package($package) if defined $Cache{$package}{mtime};\n"
+" local *FH;\n"
+" open FH, $file or die \"Failed to open '$file': $!\";\n"
+" local($/) = undef;\n"
+" my $sub = <FH>;\n"
+" close FH;\n"
+" #wrap the code into a subroutine inside our unique package\n"
+" my $eval = qq{package $package;\n"
+" use ClawsMail::Filter::Matcher;\n"
+" use ClawsMail::Filter::Action;\n"
+" use ClawsMail::Utils;\n"
+" sub handler { $sub; }};\n"
+" {\n"
+" # hide our variables within this block\n"
+" my($file,$mtime,$package,$sub);\n"
+" eval $eval;\n"
+" }\n"
+" die $@ if $@;\n"
+" #cache it unless we're cleaning out each time\n"
+" $Cache{$package}{mtime} = $mtime unless $delete;\n"
" }\n"
" eval {$package->handler;};\n"
" die $@ if $@;\n"
@@ -1662,20 +1704,20 @@
"use base qw(Exporter);\n"
"use strict;\n"
"our @EXPORT = (qw(header body filepath manual),\n"
-" qw(filter_log_verbosity filter_log),\n"
-" qw(all marked unread deleted new replied),\n"
-" qw(forwarded locked colorlabel match matchcase),\n"
-" qw(regexp regexpcase test),\n"
-" qw(to cc subject from to_or_cc newsgroups inreplyto),\n"
-" qw(references body_part headers_part message),\n"
-" qw(size_greater size_smaller size_equal),\n"
-" qw(score_greater score_lower score_equal),\n"
-" qw(age_greater age_lower partial $permanent));\n"
+" qw(filter_log_verbosity filter_log),\n"
+" qw(all marked unread deleted new replied),\n"
+" qw(forwarded locked colorlabel match matchcase),\n"
+" qw(regexp regexpcase test),\n"
+" qw(to cc subject from to_or_cc newsgroups inreplyto),\n"
+" qw(references body_part headers_part message),\n"
+" qw(size_greater size_smaller size_equal),\n"
+" qw(score_greater score_lower score_equal),\n"
+" qw(age_greater age_lower partial tagged $permanent));\n"
"# Global Variables\n"
"our(%header,$body,%msginfo,$mail_done,$manual);\n"
"our %colors = ('none' => 0,'orange' => 1,'red' => 2,\n"
-" 'pink' => 3,'sky blue' => 4,'blue' => 5,\n"
-" 'green' => 6,'brown' => 7);\n"
+" 'pink' => 3,'sky blue' => 4,'blue' => 5,\n"
+" 'green' => 6,'brown' => 7);\n"
"# For convenience\n"
"sub lc2_ {\n"
" my $arg = shift;\n"
@@ -1701,13 +1743,13 @@
"sub header {\n"
" my $key = shift;\n"
" if(not defined $key) {\n"
-" init_();\n"
-" return keys %header;\n"
+" init_();\n"
+" return keys %header;\n"
" }\n"
" $key = lc2_ $key; $key =~ s/:$//;\n"
" init_() unless exists $header{$key};\n"
" if(exists $header{$key}) {\n"
-" wantarray ? return @{$header{$key}} : return $header{$key}->[-1];\n"
+" wantarray ? return @{$header{$key}} : return $header{$key}->[-1];\n"
" }\n"
" return undef;\n"
"}\n"
@@ -1721,13 +1763,13 @@
" my $arg1 = shift;\n"
" my $arg2 = shift;\n"
" return ClawsMail::C::filter_log($arg1,$arg2)\n"
-" if defined($arg2);\n"
+" if defined($arg2);\n"
" return ClawsMail::C::filter_log(\"LOG_MANUAL\",$arg1);\n"
"}\n"
"sub filter_log_verbosity {\n"
" $_ = shift;\n"
" return ClawsMail::C::filter_log_verbosity($_)\n"
-" if defined($_);\n"
+" if defined($_);\n"
" return ClawsMail::C::filter_log_verbosity();\n"
"}\n"
"# Public Matcher Tests\n"
@@ -1742,28 +1784,29 @@
"sub ignore_thread { return ClawsMail::C::check_flag(8);}\n"
"sub age_greater {return ClawsMail::C::age_greater(@_);}\n"
"sub age_lower {return ClawsMail::C::age_lower(@_); }\n"
+"sub tagged {return ClawsMail::C::tagged(@_); }\n"
"sub score_equal {\n"
" my $my_score = shift;\n"
" return 0 unless (defined($msginfo{\"score\"}) and defined($my_score));\n"
" if($my_score == $msginfo{\"score\"}) {\n"
-" ClawsMail::C::filter_log(\"LOG_MATCH\",\"score_equal\");\n"
-" return 1;\n"
+" ClawsMail::C::filter_log(\"LOG_MATCH\",\"score_equal\");\n"
+" return 1;\n"
" }else{return 0;}\n"
"}\n"
"sub score_greater {\n"
" my $my_score = shift;\n"
" return 0 unless (defined($msginfo{\"score\"}) and defined($my_score));\n"
" if($msginfo{\"score\"} > $my_score) {\n"
-" ClawsMail::C::filter_log(\"LOG_MATCH\",\"score_greater\");\n"
-" return 1;\n"
+" ClawsMail::C::filter_log(\"LOG_MATCH\",\"score_greater\");\n"
+" return 1;\n"
" }else{return 0;}\n"
"}\n"
"sub score_lower {\n"
" my $my_score = shift;\n"
" return 0 unless (defined($msginfo{\"score\"}) and defined($my_score));\n"
" if($msginfo{\"score\"} < $my_score) {\n"
-" ClawsMail::C::filter_log(\"LOG_MATCH\",\"score_lower\");\n"
-" return 1;\n"
+" ClawsMail::C::filter_log(\"LOG_MATCH\",\"score_lower\");\n"
+" return 1;\n"
" }else{return 0;}\n"
"}\n"
"sub colorlabel {\n"
@@ -1777,33 +1820,33 @@
" my $my_size = shift;\n"
" return 0 unless (defined($msginfo{\"size\"}) and defined($my_size));\n"
" if($msginfo{\"size\"} > $my_size) {\n"
-" ClawsMail::C::filter_log(\"LOG_MATCH\",\"size_greater\");\n"
-" return 1;\n"
+" ClawsMail::C::filter_log(\"LOG_MATCH\",\"size_greater\");\n"
+" return 1;\n"
" }else{return 0;}\n"
"}\n"
"sub size_smaller {\n"
" my $my_size = shift;\n"
" return 0 unless (defined($msginfo{\"size\"}) and defined($my_size));\n"
" if($msginfo{\"size\"} < $my_size) {\n"
-" ClawsMail::C::filter_log(\"LOG_MATCH\",\"size_smaller\");\n"
-" return 1;\n"
+" ClawsMail::C::filter_log(\"LOG_MATCH\",\"size_smaller\");\n"
+" return 1;\n"
" }else{return 0;}\n"
"}\n"
"sub size_equal {\n"
" my $my_size = shift;\n"
" return 0 unless (defined($msginfo{\"size\"}) and defined($my_size));\n"
" if($msginfo{\"size\"} == $my_size) {\n"
-" ClawsMail::C::filter_log(\"LOG_MATCH\",\"size_equal\");\n"
-" return 1;\n"
+" ClawsMail::C::filter_log(\"LOG_MATCH\",\"size_equal\");\n"
+" return 1;\n"
" }else{return 0;}\n"
"}\n"
"sub partial {\n"
" return 0 unless defined($msginfo{\"total_size\"})\n"
-" and defined($msginfo{\"size\"});\n"
+" and defined($msginfo{\"size\"});\n"
" if($msginfo{\"total_size\"} != 0\n"
" && $msginfo{\"size\"} != $msginfo{\"total_size\"}) {\n"
-" ClawsMail::C::filter_log(\"LOG_MATCH\",\"partial\");\n"
-" return 1;\n"
+" ClawsMail::C::filter_log(\"LOG_MATCH\",\"partial\");\n"
+" return 1;\n"
" }else{return 0;}\n"
"}\n"
"sub test {\n"
@@ -1835,28 +1878,28 @@
" my $retval;\n"
" $retval = match_(@_,\"i\");\n"
" ClawsMail::C::filter_log(\"LOG_MATCH\",\"matchcase: $_[0], $_[1]\")\n"
-" if $retval;\n"
+" if $retval;\n"
" return $retval;\n"
"}\n"
"sub match {\n"
" my $retval;\n"
" $retval = match_(@_);\n"
" ClawsMail::C::filter_log(\"LOG_MATCH\",\"match: $_[0], $_[1]\")\n"
-" if $retval;\n"
+" if $retval;\n"
" return $retval;\n"
"}\n"
"sub regexpcase {\n"
" my $retval;\n"
" $retval = match_(@_,\"ri\");\n"
" ClawsMail::C::filter_log(\"LOG_MATCH\",\"regexpcase: $_[0], $_[1]\")\n"
-" if $retval;\n"
+" if $retval;\n"
" return $retval;\n"
"}\n"
"sub regexp {\n"
" my $retval;\n"
" $retval = match_(@_,\"r\");\n"
" ClawsMail::C::filter_log(\"LOG_MATCH\",\"regexp: $_[0], $_[1]\")\n"
-" if $retval;\n"
+" if $retval;\n"
" return $retval;\n"
"}\n"
"# Internals\n"
@@ -1889,9 +1932,9 @@
" add_header_entries_(\"xref\", ClawsMail::C::filter_init(10));\n"
" add_header_entries_(\"xface\", ClawsMail::C::filter_init(11));\n"
" add_header_entries_(\"dispositionnotificationto\",\n"
-" ClawsMail::C::filter_init(12));\n"
+" ClawsMail::C::filter_init(12));\n"
" add_header_entries_(\"returnreceiptto\",\n"
-" ClawsMail::C::filter_init(13));\n"
+" ClawsMail::C::filter_init(13));\n"
" add_header_entries_(\"references\",ClawsMail::C::filter_init(14));\n"
" $msginfo{\"score\"} = ClawsMail::C::filter_init(15);\n"
" $msginfo{\"plaintext_file\"} = ClawsMail::C::filter_init(17);\n"
@@ -1907,83 +1950,103 @@
" my($key,$value);\n"
" %header = ();\n"
" while(($key,$value) = ClawsMail::C::get_next_header()) {\n"
-" next unless $key =~ /:$/;\n"
-" add_header_entries_($key,$value);\n"
+" next unless $key =~ /:$/;\n"
+" add_header_entries_($key,$value);\n"
" }\n"
"}\n"
"sub read_body_ {\n"
" my $line;\n"
" while(defined($line = ClawsMail::C::get_next_body_line())) {\n"
-" $body .= $line;\n"
+" $body .= $line;\n"
" } \n"
"}\n"
"sub match_ {\n"
-" my ($where,$what,$modi) = @_; $modi ||= \"\";\n"
-" my $nocase=\"\"; $nocase = \"1\" if (index($modi,\"i\") != -1);\n"
-" my $regexp=\"\"; $regexp = \"1\" if (index($modi,\"r\") != -1);\n"
-" if($where eq \"to_or_cc\") {\n"
-" if(not $regexp) { \n"
-" return ((index(header(\"to\"),$what) != -1) or\n"
-" (index(header(\"cc\"),$what) != -1)) unless $nocase;\n"
-" return ((index(lc2_(header(\"to\")),lc2_($what)) != -1) or\n"
-" (index(lc2_(header(\"cc\")),lc2_($what)) != -1))\n"
-" } else {\n"
-" return ((header(\"to\") =~ m/$what/) or\n"
-" (header(\"cc\") =~ m/$what/)) unless $nocase;\n"
-" return ((header(\"to\") =~ m/$what/i) or\n"
-" (header(\"cc\") =~ m/$what/i));\n"
-" }\n"
-" } elsif($where eq \"body_part\") {\n"
-" my $mybody = body(); $mybody =~ s/\\s+/ /g;\n"
-" if(not $regexp) {\n"
-" return (index($mybody,$what) != -1) unless $nocase;\n"
-" return (index(lc2_($mybody),lc2_($what)) != -1);\n"
-" } else {\n"
-" return ($body =~ m/$what/) unless $nocase;\n"
-" return ($body =~ m/$what/i);\n"
-" }\n"
-" } elsif($where eq \"headers_part\") {\n"
-" my $myheader = header_as_string_();\n"
-" if(not $regexp) {\n"
-" $myheader =~ s/\\s+/ /g;\n"
-" return (index($myheader,$what) != -1) unless $nocase;\n"
-" return (index(lc2_($myheader),lc2_($what)) != -1);\n"
-" } else {\n"
-" return ($myheader =~ m/$what/) unless $nocase;\n"
-" return ($myheader =~ m/$what/i);\n"
-" }\n"
-" } elsif($where eq \"message\") {\n"
-" my $message = header_as_string_();\n"
-" $message .= \"\\n\".body();\n"
-" if(not $regexp) {\n"
-" $message =~ s/\\s+/ /g;\n"
-" return (index($message,$what) != -1) unless $nocase;\n"
-" return (index(lc2_($message),lc2_($what)) != -1);\n"
-" } else {\n"
-" return ($message =~ m/$what/) unless $nocase;\n"
-" return ($message =~ m/$what/i);\n"
-" }\n"
+" my ($where,$what,$modi) = @_; $modi ||= \"\";\n"
+" my $nocase=\"\"; $nocase = \"1\" if (index($modi,\"i\") != -1);\n"
+" my $regexp=\"\"; $regexp = \"1\" if (index($modi,\"r\") != -1);\n"
+" if($where eq \"to_or_cc\") {\n"
+" if(not $regexp) { \n"
+" return ((index(header(\"to\"),$what) != -1) or\n"
+" (index(header(\"cc\"),$what) != -1)) unless $nocase;\n"
+" return ((index(lc2_(header(\"to\")),lc2_($what)) != -1) or\n"
+" (index(lc2_(header(\"cc\")),lc2_($what)) != -1))\n"
" } else {\n"
-" $where = lc2_ $where;\n"
-" my $myheader = header(lc2_ $where); $myheader ||= \"\";\n"
-" return 0 unless $myheader;\n"
-" if(not $regexp) { \n"
-" return (index(header($where),$what) != -1) unless $nocase;\n"
-" return (index(lc2_(header($where)),lc2_($what)) != -1);\n"
-" } else {\n"
-" return (header($where) =~ m/$what/) unless $nocase;\n"
-" return (header($where) =~ m/$what/i);\n"
-" } \n"
+" return ((header(\"to\") =~ m/$what/) or\n"
+" (header(\"cc\") =~ m/$what/)) unless $nocase;\n"
+" return ((header(\"to\") =~ m/$what/i) or\n"
+" (header(\"cc\") =~ m/$what/i));\n"
+" }\n"
+" } elsif($where eq \"body_part\") {\n"
+" my $mybody = body(); $mybody =~ s/\\s+/ /g;\n"
+" if(not $regexp) {\n"
+" return (index($mybody,$what) != -1) unless $nocase;\n"
+" return (index(lc2_($mybody),lc2_($what)) != -1);\n"
+" } else {\n"
+" return ($body =~ m/$what/) unless $nocase;\n"
+" return ($body =~ m/$what/i);\n"
+" }\n"
+" } elsif($where eq \"headers_part\") {\n"
+" my $myheader = header_as_string_();\n"
+" if(not $regexp) {\n"
+" $myheader =~ s/\\s+/ /g;\n"
+" return (index($myheader,$what) != -1) unless $nocase;\n"
+" return (index(lc2_($myheader),lc2_($what)) != -1);\n"
+" } else {\n"
+" return ($myheader =~ m/$what/) unless $nocase;\n"
+" return ($myheader =~ m/$what/i);\n"
+" }\n"
+" } elsif($where eq \"message\") {\n"
+" my $message = header_as_string_();\n"
+" $message .= \"\\n\".body();\n"
+" if(not $regexp) {\n"
+" $message =~ s/\\s+/ /g;\n"
+" return (index($message,$what) != -1) unless $nocase;\n"
+" return (index(lc2_($message),lc2_($what)) != -1);\n"
+" } else {\n"
+" return ($message =~ m/$what/) unless $nocase;\n"
+" return ($message =~ m/$what/i);\n"
+" }\n"
+" } elsif($where eq \"tag\") {\n"
+" my $found = 0;\n"
+" sub ClawsMail::Utils::get_tags;"
+" foreach my $tag (ClawsMail::Utils::get_tags) {\n"
+" if(not $regexp) {\n"
+" if($nocase) {\n"
+" $found = (index(lc2_($tag),lc2_($what)) != -1);\n"
+" } else {\n"
+" $found = (index($tag,$what) != -1);\n"
+" }\n"
+" } else {\n"
+" if ($nocase) {\n"
+" $found = ($tag =~ m/$what/i);\n"
+" } else {\n"
+" $found = ($tag =~ m/$what/);\n"
+" }\n"
+" }\n"
+" last if $found;\n"
" }\n"
+" return $found;"
+" } else {\n"
+" $where = lc2_ $where;\n"
+" my $myheader = header(lc2_ $where); $myheader ||= \"\";\n"
+" return 0 unless $myheader;\n"
+" if(not $regexp) { \n"
+" return (index(header($where),$what) != -1) unless $nocase;\n"
+" return (index(lc2_(header($where)),lc2_($what)) != -1);\n"
+" } else {\n"
+" return (header($where) =~ m/$what/) unless $nocase;\n"
+" return (header($where) =~ m/$what/i);\n"
+" } \n"
+" }\n"
"}\n"
"sub header_as_string_ {\n"
" my $headerstring=\"\";\n"
" my @headerkeys = header(); my(@fields,$field);\n"
" foreach $field (@headerkeys) {\n"
-" @fields = header($field);\n"
-" foreach (@fields) {\n"
-" $headerstring .= $field.\": \".$_.\"\\n\";\n"
-" }\n"
+" @fields = header($field);\n"
+" foreach (@fields) {\n"
+" $headerstring .= $field.\": \".$_.\"\\n\";\n"
+" }\n"
" }\n"
" return $headerstring;\n"
"}\n"
@@ -1995,15 +2058,15 @@
"package ClawsMail::Filter::Action;\n"
"use base qw(Exporter);\n"
"our @EXPORT = (qw(mark unmark dele mark_as_unread mark_as_read),\n"
-" qw(lock unlock move copy color execute),\n"
-" qw(hide set_score change_score stop exit),\n"
-" qw(forward forward_as_attachment redirect),\n"
+" qw(lock unlock move copy color execute),\n"
+" qw(hide set_score change_score stop exit),\n"
+" qw(forward forward_as_attachment redirect),\n"
" qw(set_tag unset_tag clear_tags),\n"
-" );\n"
+" );\n"
"our %colors = ('none' => 0,'orange' => 1,\n"
-" 'red' => 2,'pink' => 3,\n"
-" 'sky blue' => 4,'blue' => 5,\n"
-" 'green' => 6,'brown' => 7);\n"
+" 'red' => 2,'pink' => 3,\n"
+" 'sky blue' => 4,'blue' => 5,\n"
+" 'green' => 6,'brown' => 7);\n"
"sub mark { ClawsMail::C::set_flag (1);}\n"
"sub unmark { ClawsMail::C::unset_flag(1);}\n"
"sub mark_as_unread { ClawsMail::C::set_flag (2);}\n"
@@ -2022,16 +2085,16 @@
"sub stop {\n"
" my $nolog = shift;\n"
" ClawsMail::C::filter_log(\"LOG_ACTION\", \"stop\")\n"
-" unless defined($nolog);\n"
+" unless defined($nolog);\n"
" die 'intended';\n"
"}\n"
"sub set_score {\n"
" $ClawsMail::Filter::Matcher::msginfo{\"score\"} =\n"
-" ClawsMail::C::set_score(@_);\n"
+" ClawsMail::C::set_score(@_);\n"
"}\n"
"sub change_score {\n"
" $ClawsMail::Filter::Matcher::msginfo{\"score\"} =\n"
-" ClawsMail::C::change_score(@_);\n"
+" ClawsMail::C::change_score(@_);\n"
"}\n"
"sub execute {\n"
" my $flv; my $cmd = shift; return 0 unless defined($cmd);\n"
@@ -2059,11 +2122,11 @@
"package ClawsMail::Utils;\n"
"use base qw(Exporter);\n"
"our @EXPORT = (\n"
-" qw(SA_is_spam extract_addresses move_to_trash abort),\n"
-" qw(addr_in_addressbook from_in_addressbook),\n"
-" qw(get_attribute_value make_sure_folder_exists),\n"
-" qw(make_sure_tag_exists),\n"
-" );\n"
+" qw(SA_is_spam extract_addresses move_to_trash abort),\n"
+" qw(addr_in_addressbook from_in_addressbook),\n"
+" qw(get_attribute_value make_sure_folder_exists),\n"
+" qw(make_sure_tag_exists get_tags),\n"
+" );\n"
"# Spam\n"
"sub SA_is_spam {\n"
" my $retval;\n"
@@ -2073,14 +2136,14 @@
"}\n"
"# simple extract email addresses from a header field\n"
"sub extract_addresses {\n"
-" my $hf = shift; return undef unless defined($hf);\n"
-" my @addr = ();\n"
-" while($hf =~ m/[-.+\\w]+\\@[-.+\\w]+/) {\n"
-" $hf =~ s/^.*?([-.+\\w]+\\@[-.+\\w]+)//;\n"
-" push @addr,$1;\n"
-" }\n"
-" push @addr,\"\" unless @addr;\n"
-" return @addr;\n"
+" my $hf = shift; return undef unless defined($hf);\n"
+" my @addr = ();\n"
+" while($hf =~ m/[-.+\\w]+\\@[-.+\\w]+/) {\n"
+" $hf =~ s/^.*?([-.+\\w]+\\@[-.+\\w]+)//;\n"
+" push @addr,$1;\n"
+" }\n"
+" push @addr,\"\" unless @addr;\n"
+" return @addr;\n"
"}\n"
"# move to trash\n"
"sub move_to_trash {\n"
@@ -2094,6 +2157,9 @@
"sub make_sure_tag_exists {\n"
" ClawsMail::C::make_sure_tag_exists(@_);\n"
"}\n"
+"sub get_tags {\n"
+" ClawsMail::C::get_tags(@_);\n"
+"}\n"
"# abort: stop() and do not continue with built-in filtering\n"
"sub abort {\n"
" ClawsMail::C::abort();\n"
@@ -2188,10 +2254,10 @@
return;
}
if (fprintf(pfile->fp, "\n") < 0) {
- FILE_OP_ERROR(rcpath, "fprintf");
- prefs_file_close_revert(pfile);
- } else
- prefs_file_close(pfile);
+ FILE_OP_ERROR(rcpath, "fprintf");
+ prefs_file_close_revert(pfile);
+ } else
+ prefs_file_close(pfile);
}
gint plugin_init(gchar **error)
@@ -2205,21 +2271,21 @@
gchar *rcpath;
/* version check */
- if(!check_plugin_version(MAKE_NUMERIC_VERSION(3,7,4,6),
- VERSION_NUMERIC, "Perl", error))
- return -1;
+ if(!check_plugin_version(MAKE_NUMERIC_VERSION(3,7,4,6),
+ VERSION_NUMERIC, "Perl", error))
+ return -1;
/* register hook for automatic and manual filtering */
filtering_hook_id = hooks_register_hook(MAIL_FILTERING_HOOKLIST,
- my_filtering_hook,
- GUINT_TO_POINTER(AUTO_FILTER));
+ my_filtering_hook,
+ GUINT_TO_POINTER(AUTO_FILTER));
if(filtering_hook_id == (guint) -1) {
*error = g_strdup("Failed to register mail filtering hook");
return -1;
}
manual_filtering_hook_id = hooks_register_hook(MAIL_MANUAL_FILTERING_HOOKLIST,
- my_filtering_hook,
- GUINT_TO_POINTER(MANU_FILTER));
+ my_filtering_hook,
+ GUINT_TO_POINTER(MANU_FILTER));
if(manual_filtering_hook_id == (guint) -1) {
hooks_unregister_hook(MAIL_FILTERING_HOOKLIST, filtering_hook_id);
*error = g_strdup("Failed to register manual mail filtering hook");
@@ -2236,9 +2302,9 @@
*error = g_strdup("Failed to create blank scriptfile");
g_free(perlfilter);
hooks_unregister_hook(MAIL_FILTERING_HOOKLIST,
- filtering_hook_id);
+ filtering_hook_id);
hooks_unregister_hook(MAIL_MANUAL_FILTERING_HOOKLIST,
- manual_filtering_hook_id);
+ manual_filtering_hook_id);
return -1;
}
/* chmod for security */
@@ -2265,23 +2331,23 @@
if(status) {
*error = g_strdup("Failed to load Perl Interpreter\n");
hooks_unregister_hook(MAIL_FILTERING_HOOKLIST,
- filtering_hook_id);
+ filtering_hook_id);
hooks_unregister_hook(MAIL_MANUAL_FILTERING_HOOKLIST,
- manual_filtering_hook_id);
+ manual_filtering_hook_id);
return -1;
}
perl_gtk_init();
debug_print("Perl Plugin loaded\n");
- return 0;
+ return 0;
}
gboolean plugin_done(void)
{
hooks_unregister_hook(MAIL_FILTERING_HOOKLIST,
- filtering_hook_id);
+ filtering_hook_id);
hooks_unregister_hook(MAIL_MANUAL_FILTERING_HOOKLIST,
- manual_filtering_hook_id);
+ manual_filtering_hook_id);
free_all_lists();
@@ -2328,8 +2394,8 @@
struct PluginFeature *plugin_provides(void)
{
- static struct PluginFeature features[] =
- { {PLUGIN_FILTERING, N_("Perl integration")},
- {PLUGIN_NOTHING, NULL}};
- return features;
+ static struct PluginFeature features[] =
+ { {PLUGIN_FILTERING, N_("Perl integration")},
+ {PLUGIN_NOTHING, NULL}};
+ return features;
}
More information about the Commits
mailing list