[Mew-dist 1401] IMAP Scanning
若宮賢二
wkenji at example.com
1997年 7月 31日 (木) 12:35:07 JST
若宮＠富士通研です。
しばらく Mew の IMAP 対応について考えていたのですが、im-48 では imls
や imcat にも IMAP 用のコードが入っていますね。Mew 側の対応もすぐ行な
われるのでしょうか？
とりあえず imls を少し試してみて、個人的に考えていたものと照らし合わせ
て以下のようなことをやってみました。もし使える所があったら使ってやって
下さい。
- メッセージ指定/表示を UID ベースに。
UID のほうがローカルフォルダの場合に似ているのと、
将来オフライン処理などをサポートし易い?かと思いまして (漠然)。
- メッセージのレンジ指定を可能に。
ローカルな imls と同じです。
- ヘッダ情報の fetch を一回に。
FETCH コマンドを一通ごとに発行しないようにしました。
多くの部分を Imap.pm に入れてしまったのですが、他との整合性が悪いし、
あまり綺麗じゃないですね…。
＃Perl は型グロブがいまいち理解できません;-)。
// Kenji | mailto:wkenji at example.com (office)
// Wakamiya | mailto:wkenji at example.com (private)
-------------- next part --------------
--- imls.in- Sat Jul 26 00:08:43 1997
+++ imls.in Thu Jul 31 12:12:02 1997
@@ -103,7 +103,7 @@
} elsif (/^\%(.*)$/) {
require IM::Imap && import IM::Imap;
require IM::GetPass && import IM::GetPass;
- &imap_messages($1);
+ &imap_messages($1, @ARGV);
} else {
im_die("doesn't support $opt_src\n");
}
@@ -430,8 +430,8 @@
## IMAP
##
-sub imap_messages {
- my($folder) = @_;
+sub imap_messages ($@) {
+ my ($folder, @ranges) = (shift, @_);
my ($host, $user, $auth, $rest);
if ($folder =~ /\:/) {
@@ -470,38 +470,26 @@
im_warn("$ErrMsg\n");
# im_warn("IMAP connection was not established.\n")
# if (&debug("imap") || &verbose);
+ $scan_count = -1;
return -1;
}
- my $start = 1;
- my $end = &imap_select($folder, 1);
- if ($msgs < 0) {
+ my $exists = &imap_select($folder, 1);
+ if ($exists < 0) {
&imap_close;
- im_warn("can't access to $folder");
+ im_warn("can't select $folder\@$host.\n");
+ $scan_count = -1;
return -1;
- } elsif ($msgs < $msg) {
- &imap_close;
- im_info("message $msg not found in \%$folder");
- return -1;
- }
-
-# if ($ARGV[0] ne 'all') {
-# # XXX
-# }
-
- foreach $i ($start..$end) {
- (my $rc, local *Head) = &imap_head($i);
- next if ($rc < 0);
- $Head{'number'} = $i;
- $Head{'folder'} = "\%$folder";
- parse_header(\%Head);
- if ($opt_thread) {
- &make_thread(%Head);
- } else {
- &disp_msg(\%Head);
- $scan_count++;
+ } elsif ($exists > 0) {
+ if (&imap_scan_folder(@ranges) < 0) {
+ &imap_close;
+ im_warn("IMAP folder scanning error.\n")
+ if (&debug("imap") || &verbose);
+ $scan_count = -1;
+ return -1;
}
}
&imap_close;
+ return 0;
}
sub sort_uniq {
-------------- next part --------------
--- Imap.pm.in- Fri Jul 25 15:47:34 1997
+++ Imap.pm.in Thu Jul 31 12:12:10 1997
@@ -24,13 +24,14 @@
use IM::GetPass;
use IM::EncDec;
use IM::MsgStore;
+use IM::Scan;
@ISA = qw(Exporter);
@EXPORT = qw(
imap_open imap_close imap_select imap_head imap_from imap_get imap_put
imap_delete imap_copy imap_flags
imap_list_folder imap_create_folder imap_delete_folder imap_rename_folder
- imap_get_msg imap_process imap_spec
+ imap_get_msg imap_process imap_spec imap_scan_folder
);
=head1 NAME
@@ -579,4 +580,127 @@
}
return ($folder, $auth, $user, $host);
+}
+
+############################################
+##
+## For imls
+##
+
+sub imap_scan_folder (@) {
+ my @ranges = @_;
+ my $msgset, $seq, $resp;
+ my $uid, $size, $len, $field, %Head;
+
+ $msgset = &imap_range2set(@ranges);
+ return -1 if ($msgset < 0);
+ $seq = $ImapSeq++;
+ $resp = &send_command(\*IMAPd,
+ "im$seq UID FETCH $msgset (UID RFC822.SIZE RFC822.HEADER)", '');
+ while ($resp =~
+ /^\* \d+ FETCH \(UID (\d+) RFC822.SIZE (\d+) RFC822\.HEADER \{(\d+)\}/i) {
+ ($uid, $size, $len) = ($1, $2, $3);
+ ($field, %Head) = ('', ());
+ while (<IMAPd>) {
+ $len -= length;
+ s/\r?\n$//;
+ im_warn("$_") if (&debug("imap") || &verbose);
+ if (/^\s/) {
+ s/^\s+//;
+ $Head{$field} = $Head{$field} . $_;
+ last if ($len <= 0);
+ next;
+ } elsif (/^([^:]+):\s*/) {
+ $field = lc($1);
+ $Head{$field} = $';
+ } else {
+ $inheader = 0;
+ last if ($len <= 0);
+ next;
+ }
+ last if ($len <= 0);
+ }
+ $resp = &next_response(\*IMAPd);
+ return -1 if ($resp !~ /^\)/);
+
+# $Head{'bytes:'} = $size;
+ $Head{'kbytes:'} = int(($size + 1023) / 1024);
+ $Head{'number'} = $uid;
+ $Head{'folder'} = "\%$folder";
+ parse_header(\%Head);
+
+ if ($opt_thread) {
+ &make_thread(%Head);
+ } else {
+ &disp_msg(\%Head);
+ $main::scan_count++;
+ }
+ $resp = &next_response(\*IMAPd);
+ }
+ if ($resp !~ /^im$seq OK/) {
+ im_warn("FETCH command failed.\n") if (&debug("imap") || &verbose);
+ return -1;
+ }
+ return 0;
+}
+
+sub imap_range2set (@) {
+ my @ranges = @_;
+ my @alluids, $min, $max;
+ my @uids, $fromuid, $touid, $dir;
+
+ @alluids = &imap_all_uids;
+ return -1 if ($alluids[0] < 0);
+ ($min, $max) = ($alluids[0], $alluids[$#alluids]);
+
+ @ranges = ('first-last') if (!@ranges || grep(/^all$/, @ranges));
+ foreach (@ranges) {
+ if (/^(\d+|first|last)-(\d+|first|last)$/) {
+ $fromuid = &imap_message_number($min, $max, $1);
+ $touid = &imap_message_number($min, $max, $2);
+ $_ = "$fromuid:$touid";
+ } elsif (/^(\d+|last|first):([+-]?)(\d+)$/) {
+ if ($1 eq 'last') {
+ $dir = (!$2 || $2 eq '-') ? -1 : +1;
+ } else {
+ $dir = (!$2 || $2 eq '+') ? +1 : -1;
+ }
+ $fromuid = &imap_message_number($min, $max, $1);
+ if ($dir > 0) {
+ @uids = grep($_ >= $fromuid, @alluids);
+ splice(@uids, $3) if ($3 < @uids);
+ } else {
+ @uids = grep($_ <= $fromuid, @alluids);
+ splice(@uids, 0, @uids - $3) if ($3 < @uids);
+ }
+ $_ = join(',', @uids);
+ } elsif (/^(\d+|first|last)$/) {
+ $_ = &imap_message_number($min, $max, $1);
+ }
+ }
+ return join(',', @ranges);
+}
+
+sub imap_all_uids () {
+ my $seq, $resp, @uids;
+
+ $seq = $ImapSeq++;
+ $resp = &send_command(\*IMAPd, "im$seq UID SEARCH 1:*", '');
+ if ($resp =~ /^\* SEARCH ((\d+[ ]?)*)/i) {
+ @uids = split(' ', $1);
+ } else {
+ im_warn("SEARCH command failed.\n") if (&debug("imap") || &verbose);
+ }
+ $resp = &next_response(\*IMAPd);
+ return (-1) if ($resp !~ /^im$seq OK/);
+ return @uids;
+}
+
+sub imap_message_number ($$$) {
+ my ($min, $max, $num) = @_;
+
+ return $num if $num =~ /^\d+$/;
+ return $min if $num =~ /^first$/;
+ return $max if $num =~ /^last$/;
+ return '';
}
Mew-dist メーリングリストの案内