nottoomuch-addresses-2.0.sh nottoomuch-addresses-2.1.sh
9# $ nottoomuch-addresses.sh $9# $ nottoomuch-addresses.sh $
10#10#
11# Created: Thu 27 Oct 2011 17:38:46 EEST too11# Created: Thu 27 Oct 2011 17:38:46 EEST too
12# Last modified: Sat 14 Jan 2012 05:45:00 EET too12# Last modified: Wed 22 Feb 2012 16:58:58 EET too
1313
14# Add this to your notmuch elisp configuration file:14# Add this to your notmuch elisp configuration file:
15#15#
2424
25# HISTORY25# HISTORY
26#26#
27# Version 2.1 2012-02-22 14:58:58 UTC
28# * Fixed a bug where decoding matching but unknown or malformed =?...?=-
29# encoded parts in email addresses lead to infinite loop.
30#
27# Version 2.0 2012-01-14 03:45:00 UTC31# Version 2.0 2012-01-14 03:45:00 UTC
28# * Added regexp-based igrores using /regexp/[i] syntax in ignore file.32# * Added regexp-based ignores using /regexp/[i] syntax in ignore file.
29# * Changed addresses file header to v4; 'addresses' file now contains all33# * Changed addresses file header to v4; 'addresses' file now contains all
30# found addresses plus some metainformation added at the end of the file.34# found addresses plus some metainformation added at the end of the file.
31# Filtered (by ignores) address list is now in new 'addresses.active'35# Filtered (by ignores) address list is now in new 'addresses.active'
34# * Encoded address content is now recursively decoded.38# * Encoded address content is now recursively decoded.
35#39#
36# Version 1.6 2011-12-29 06:42:42 UTC40# Version 1.6 2011-12-29 06:42:42 UTC
37# * Fixed 'encoded-text' regognization and concatenations, and underscore41# * Fixed 'encoded-text' recognition and concatenations, and underscore
38# to space replacements. Now quite RFC 2047 "compliant".42# to space replacements. Now quite RFC 2047 "compliant".
39#43#
40# Version 1.5 2011-12-22 20:20:32 UTC44# Version 1.5 2011-12-22 20:20:32 UTC
165 my $sometime = time;169 my $sometime = time;
166 die "Cannot open '$adbpath.new': $!\n" unless open O, '>', $adbpath.'.new';170 die "Cannot open '$adbpath.new': $!\n" unless open O, '>', $adbpath.'.new';
167 die "Cannot open '$actpath.new': $!\n" unless open A, '>', $actpath.'.new';171 die "Cannot open '$actpath.new': $!\n" unless open A, '>', $actpath.'.new';
168 $_ = $sometime; s/(..)\B/$1\t/g;172 $_ = $sometime; s/(..)\B/$1\t/g; # FYI: s/..\B\K/\t/g requires perl 5.10.
169 print O "v4\t$_\n";173 print O "v4\t$_\n";
170174
171 # The following code block is from Email::Address, almost verbatim.175 # The following code block is from Email::Address, almost verbatim.
294 ($user, $host) = ($1, $2);298 ($user, $host) = ($1, $2);
295 }299 }
296300
297 sub decode_data () {301 sub decode_substring ($) {
298 my $t = lc $2;302 my $t = lc $2;
299 my $s;303 my $s;
300 if ($t eq 'b') { $s = decode_base64($3); }304 if ($t eq 'b') { $s = decode_base64($3); }
301 elsif ($t eq 'q') { $s = decode_qp($3); }305 elsif ($t eq 'q') { $s = decode_qp($3); }
302 else {306 else {
307 $_[0] = 0;
303 return "=?$1?$2?$3?=";308 return "=?$1?$2?$3?=";
304 }309 }
305 $s =~ tr/_/ /;310 $s =~ tr/_/ /;
307 return $s if lc $1 eq 'utf-8';312 return $s if lc $1 eq 'utf-8';
308313
309 my $o = find_encoding($1);314 my $o = find_encoding($1);
310 return "=?$1?$2?$3?=" unless ref $o;315 $_[0] = 0, return "=?$1?$2?$3?=" unless ref $o;
311 return encode_utf8($o->decode($s));316 return encode_utf8($o->decode($s));
312 }317 }
318 sub decode_data () {
319 my $loopmax = 5;
320 while ( s{ =\?([^?]+)\?(\w)\?(.*?)\?= }
321 { decode_substring($loopmax) }gex ) {
322 last if --$loopmax <= 0;
323 };
324 }
313325
314 my @phrase = /($display_name)/o;326 my @phrase = /($display_name)/o;
315 foreach (@phrase) {327 decode_data foreach (@phrase);
316 while ( s/=\?([^?]+)\?(\w)\?(.*?)\?=/decode_data/ge ) {};
317 }
318328
319 for ( @phrase, $host, $user, @comments ) {329 for ( @phrase, $host, $user, @comments ) {
320 next unless defined $_;330 next unless defined $_;
334 }344 }
335 my $userhost = lc "<$user\@$host>";345 my $userhost = lc "<$user\@$host>";
336 #my $userhost = "<$user\@$host>";346 #my $userhost = "<$user\@$host>";
347
337 @comments = grep { defined or return 0;348 @comments = grep { defined or return 0; decode_data; 1; } @comments;
338 s/=\?([^?]+)\?(\w)\?(.*?)\?=/decode_data/ge; 1;
339 } @comments;
340 #@comments = grep { defined } @comments;
341349
342 @phrase = () unless defined $phrase[0];350 @phrase = () unless defined $phrase[0];
343 $_ = join(' ', @phrase, $userhost, @comments) . "\n";351 $_ = join(' ', @phrase, $userhost, @comments) . "\n";
412420
413=head1 VERSION421=head1 VERSION
414422
4152.0 (2011-01-14)4232.1 (2011-02-22)
416424
417=head1 OPTIONS425=head1 OPTIONS
418426
486494
487Tomi Ollila -- too ät iki piste fi495Tomi Ollila -- too ät iki piste fi
488496
489=head1 ACKNOWLEDGEMENTS497=head1 ACKNOWLEDGMENTS
490498
491This program uses code from Email::Address, Copyright (c) by Casey West499This program uses code from Email::Address, Copyright (c) by Casey West
492and maintained by Ricardo Signes. Thank you. All new bugs are mine,500and maintained by Ricardo Signes. Thank you. All new bugs are mine,

Generated by htmldiff.sh