[Commits] .cvsignore NONE 1.1.2.1 Makefile.am NONE 1.1.2.1 insert_perl.pl NONE 1.1.2.1 matcherrc2perlfilter.pl NONE 1.1.2.1
mones at claws-mail.org
mones at claws-mail.org
Thu Feb 28 22:43:51 CET 2013
Update of /home/claws-mail/claws/src/plugins/perl/tools
In directory srv:/tmp/cvs-serv27630/src/plugins/perl/tools
Added Files:
Tag: gtk2
.cvsignore Makefile.am insert_perl.pl matcherrc2perlfilter.pl
Log Message:
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.
--- NEW FILE: .cvsignore ---
Makefile
Makefile.in
--- NEW FILE: matcherrc2perlfilter.pl ---
#!/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;
}
--- NEW FILE: Makefile.am ---
EXTRA_TOOLS = \
matcherrc2perlfilter.pl
EXTRA_DIST = \
$(EXTRA_TOOLS)
MAKE_EXE = chmod u+x $(EXTRA_TOOLS)
all-local:
$(MAKE_EXE)
--- NEW FILE: insert_perl.pl ---
#!/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);
More information about the Commits
mailing list