[Mew-dist 06766] Re: pick problem

[Kazumasa Utashiro]

From: SAKAI Kiyotaka <ksakai at example.com>
Subject: [Mew-dist 06704] Re: pick problem
Date: Fri, 16 Oct 1998 09:41:54 +0900

> > 今、気が付きましたが $main::opt_delimiter を無視しちゃってます。imgrep 
> > は、RFC822 的フォーマットを前提にして構わない様な気がするんですが、い
> > けませんかね?
> 
> > $main::opt_delimiter は正規表現なので、そのまま $/ に設定できないんで
> > すよ。
> 
> opt_delimiter は、+draft の中も検索対象にしたいという要望のために入れ
> たのだったと思います。

ううむ、そうでしたか。そんなのいいじゃん、と言おうかと思ったけど、実装
してみました。オプションは無視しちゃっているので、後で方針を決めて整理
する必要があります。

MIME decode の機能も入れました。何故かうまく動かないメッセージがあった
ので、EncDec.c も少し直しました。

--utashiro

-------------- 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:16:53 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,140 ----
  	    }
  	    next;
  	}
  
! 	$/ = '';
! 	$head = <MES>;		# read $head anyway
! 
! 	# 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) = '';
! 	}
! 
! 	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);
  
! 	if ($find{'head'} || $find{'all'}) {
! 	    $head =~ s/\n\s+/ /g; # fix continuation lines
! 	    $head = mime_decode_string($head);
! 	}
! 
  	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";
--- 313,321 ----
  	     }
  	     $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";