[Mew-dist 06768] Re: pick problem
Kazumasa Utashiro
utashiro at example.com
1998年 10月 21日 (水) 23:52:00 JST
From: Kazumasa Utashiro <utashiro at example.com>
Subject: [Mew-dist 06766] Re: pick problem
Date: Wed, 21 Oct 1998 23:28:04 +0900
> ううむ、そうでしたか。そんなのいいじゃん、と言おうかと思ったけど、実装
> してみました。オプションは無視しちゃっているので、後で方針を決めて整理
> する必要があります。
失礼。さっきのはキャンセルして、こっちを使ってください。all を作る前に
ヘッダの処理しなきゃでしょ。
--utashiro
p.s. 「...思ったけど、実装してみた」のは、今とても忙しくてそんなことし
ている暇ないからです... 困った、困った。
-------------- next part --------------
*** /usr/local/src/im-102/IM/EncDec.pm Mon Oct 19 21:49:59 1998
--- EncDec.pm Wed Oct 21 23:14:52 1998
***************
*** 158,164 ****
my $in = shift;
return '' if ($in eq '');
if ($in =~ /"/) {
! if ($in =~ /^([^"]*)("[^"]*")(.*)$/) {
return mime_decode_string($1) . $2 . mime_decode_string($3);
} else { # unblanced "
return $in;
--- 158,164 ----
my $in = shift;
return '' if ($in eq '');
if ($in =~ /"/) {
! if ($in =~ /^([^"]*)("[^"]*")([\0-\255]*)$/) {
return mime_decode_string($1) . $2 . mime_decode_string($3);
} else { # unblanced "
return $in;
*** /usr/local/src/im-102/IM/Grep.pm Mon Oct 19 21:49:59 1998
--- Grep.pm Wed Oct 21 23:40:16 1998
***************
*** 18,23 ****
--- 18,24 ----
use IM::Util;
use IM::Folder qw(message_range);
use IM::Japanese;
+ use IM::EncDec qw(mime_decode_string);
use integer;
use strict;
use vars qw(@ISA @EXPORT);
***************
*** 50,55 ****
--- 51,59 ----
my $range_element = '(\\d+|cur|first|last|next|prev|new)';
my $range_regexp = "($range_element(-$range_element|:[+-]?\\d+)?|all)";
+ # end of header in draft message
+ my $draft_delimiter = "\n----\n";
+
sub grep_folder ($$@) {
my ($folder, $eval_string, @ranges) = @_;
my $folder_dir;
***************
*** 87,96 ****
im_debug("uniqified messages \"@src_msgs\"\n") if &debug('all');
my $m;
- GREP:
foreach $m (@src_msgs) {
! my ($all, $head, $body) = ('', '', '');
unless (open(MES, "< $m")) {
if (! $main::opt_quiet) {
--- 91,106 ----
im_debug("uniqified messages \"@src_msgs\"\n") if &debug('all');
+ # dirty quick hack to determine what part is required
+ # should be implemented better
+ my(%find) = ('head' => scalar($eval_string =~ /\$head\s*=~/),
+ 'body' => scalar($eval_string =~ /\$body\s*=~/),
+ 'all' => scalar($eval_string =~ /\$all\s*=~/));
+
my $m;
foreach $m (@src_msgs) {
! my($all, $head, $body) = ('', '', '');
! local($/);
unless (open(MES, "< $m")) {
if (! $main::opt_quiet) {
***************
*** 98,124 ****
}
next;
}
- do {
- local($/) = "";
! # dirty quick hack to determine what part is required
! # should be implemented better
! my(%find) = ('head' => scalar($eval_string =~ /\$head\s*=~/),
! 'body' => scalar($eval_string =~ /\$body\s*=~/),
! 'all' => scalar($eval_string =~ /\$all\s*=~/));
!
! $head = <MES>; # read $head anyway
! undef $/;
! if ($find{'body'}) { # read $body if necessary
! $body = <MES>;
! }
! if ($find{'all'}) { # construct $all if necessary
! $all = $head . ($body ? $body : scalar(<MES>));
! }
! };
close(MES);
- $head =~ s/\n\s+/ /g; # fix continuation lines
if (eval $eval_string) {
push(@messages, $m);
}
--- 108,146 ----
}
next;
}
! # read $head anyway
! #
! $/ = '';
! $head = <MES>;
!
! # if the header contains draft-style header delimiter,
! # truncate the header and seek to the beginning of body.
! my $p = index($head, $draft_delimiter);
! if ($p >= 0) {
! seek(MES, $p + length($draft_delimiter), 0);
! substr($head, $p + 1) = '';
! }
! if ($find{'head'} || $find{'all'}) {
! $head =~ s/\n\s+/ /g; # fix continuation lines
! $head = mime_decode_string($head);
! }
!
! # read $body if necessary
! #
! undef $/;
! if ($find{'body'}) {
! $body = <MES>;
! }
!
! # construct $all if necessary
! #
! if ($find{'all'}) {
! $all = $head . ($body ? $body : scalar(<MES>));
! }
!
close(MES);
if (eval $eval_string) {
push(@messages, $m);
}
***************
*** 297,305 ****
}
$field =~ s/([@\/])/\\$1/g;
$pattern =~ s/([@\/])/\\$1/g;
!
if ($field eq 'body') {
- $pattern = make_japanese_pattern($pattern);
$string = "\$$field =~ /$pattern/om$case_flag";
} elsif ($field =~ /^(all|head)$/) {
$string = "\$$field =~ /$pattern/om$case_flag";
--- 319,327 ----
}
$field =~ s/([@\/])/\\$1/g;
$pattern =~ s/([@\/])/\\$1/g;
!
! $pattern = make_japanese_pattern($pattern);
if ($field eq 'body') {
$string = "\$$field =~ /$pattern/om$case_flag";
} elsif ($field =~ /^(all|head)$/) {
$string = "\$$field =~ /$pattern/om$case_flag";
Mew-dist メーリングリストの案内