[Mew-dist 03439] [im] imget by IMAP

[Yuuichi Teranishi 寺西裕一]

寺西＠にわか IMAP ユーザ です。

IMAP で imget する機能をほんのすこし向上させるパッチを作ってみました。
変更点は、

 * imget で --count で指定された数のメールだけ取って来るようにする。
 * imget でも ImapAccount をみるようにする。
 * imget で存在しない IMAP フォルダを src に指定するとハングするのを直す。
 * IMAP 関連のメッセージで src となったフォルダ名を表示するようにする。
 * IMAP 関連のエラーメッセージを少し親切にする。

です。
以下、im-82 に対するパッチになっています。

--
Yuuichi Teranishi (寺西裕一) <teranisi at example.com>
NTT Information and Communication Systems Laboratories
The love you take is equal to the love you make...

-------------- next part --------------
--- imget.in~	Wed Jan 14 14:43:11 1998
+++ imget.in	Mon Jan 19 09:59:38 1998
@@ -194,7 +194,7 @@
 	$msgs = &pop_get_msg($src, $dst, $mode);
     } elsif ($src =~ /^imap/i) {
 	require IM::Imap && import IM::Imap;
-	$msgs = &imap_get_msg($src, $dst, $mode);
+	$msgs = &imap_get_msg($src, $dst, $mode, $opt_count);
     } elsif ($src =~ /^nntp/i || $src =~ /^news/i) {
 	require IM::Nntp && import IM::Nntp;
 	$msgs = &nntp_get_msg($src, $dst, $mode, $opt_count);
-------------- next part --------------
--- Imap.pm.in~	Mon Jan 19 10:29:02 1998
+++ Imap.pm.in	Mon Jan 19 10:18:40 1998
@@ -522,16 +522,20 @@
     return 0;
 }
 
-# imap_process(handle, how, host, src, dst)
-sub imap_process ($$$$$) {
-    my ($HANDLE, $how, $host, $src, $dst) = @_;
-    my ($msgs);
-    return -1 if (($msgs = &imap_select($HANDLE, $src, 1)) < 0);
+# imap_process(handle, how, host, src, dst, limit)
+sub imap_process ($$$$$$) {
+    my ($HANDLE, $how, $host, $src, $dst, $limit) = @_;
+    my ($msgs, $count) = (0, 0);
+     if (($msgs = &imap_select($HANDLE, $src, 1)) < 0) {
+         im_warn("selecting folder $src failed.\n"); 
+         return -1;
+     }
+    $limit = $msgs if ($limit == 0);
     if ($how eq 'check') {
 	if ($msgs > 0) {
-	    im_msg("$msgs message(s) at $host.\n");
+	    im_msg("$msgs message(s) in $src at $host.\n");
 	} else {
-	    im_msg("no message at $host.\n");
+	    im_msg("no message in $src at $host.\n");
 	}
     } elsif ($how eq 'from') {
 	if ($msgs > 0) {
@@ -541,9 +545,9 @@
 	    foreach $i (@alluids) {
 		return -1 if (&imap_from($HANDLE, $i) < 0);
 	    }
-	    im_info("$msgs message(s) at $host.\n");
+	    im_info("$msgs message(s) in $src at $host.\n");
 	} else {
-	    im_info("no message at $host.\n");
+	    im_info("no message in $src at $host.\n");
 	}
     } elsif ($how eq 'get') {
 	if ($msgs > 0) {
@@ -552,24 +556,32 @@
 	    return -1 if ($alluids[0] < 0);
 	    my $i;
 	    foreach $i (@alluids) {
+	        if ($count >= $limit) {
+		    im_info("$count message(s).\n");
+		    return $count;
+		}  
 		my ($rc, $message) = &imap_get($HANDLE, $i);
 		return -1 if ($rc < 0);
 		return -1 if (&store_message($message, $dst) < 0);
 		&exec_getsbrfile($dst);
 		unless ($main::opt_keep) {
-		    return -1 if (&imap_delete($HANDLE, $i) < 0);
+ 		    if (&imap_delete($HANDLE, $i) < 0) {
+ 		        im_warn("deleting message $i failed.");
+ 		        return -1;
+ 		    }  		  
 		}
+		$count++;
 	    }
 	    im_info("$msgs message(s).\n");
 	} else {
-	    im_info("no messages at $host.\n");
+	    im_info("no message in $src at $host.\n");
 	}
     }
     return $msgs;
 }
 
-sub imap_get_msg ($$$) {
-    my ($src, $dst, $how) = @_;
+sub imap_get_msg ($$$$) {
+    my ($src, $dst, $how, $limit) = @_;
 
     $src =~ s/^imap//i;
 
@@ -596,10 +608,8 @@
     if ($rc == 0) {
 	&savepass('imap', $auth, $host, $user, $pass)
 	    if ($pass ne '' && $interact && &usepwagent());
-	my $msgs = &imap_process($HANDLE, $how, $host, $folder, $dst);
-	if ($msgs < 0) {
-	    im_warn("IMAP processing error.\n");
-	}
+	my $msgs = &imap_process($HANDLE, $how, $host, $folder, $dst, $limit);
+	return -1 if ($msgs < 0);
 	&imap_close($HANDLE);
 	return $msgs;
     } else {
@@ -614,20 +624,7 @@
 sub imap_spec ($) {
     my $spec = shift;
 
-    if ($spec eq '') {
-	my $s = imapaccount();
-	if ($s !~ /^[\/\@:]/) {
-	    if ($s =~ /\@/) {
-		$s = ":$s";
-	    } else {
-		$s = "\@$s";
-	    }
-	}
-	$spec = $s if ($s ne '');
-    }
-
-    my ($folder, $auth, $host) = ('INBOX', 'auth', 'localhost');
-    my $user = $ENV{'USER'} || $ENV{'LOGNAME'} || im_getlogin();
+    my ($folder, $auth, $host, $user) = ('INBOX', 'auth', '', '');
 
     while ($spec ne '') {
 	if ($spec =~ /^%([^%:\@]+)(.*)/) {	# XXX
@@ -645,6 +642,20 @@
 	$spec = $2;
     }
 
+    if (($user eq '') || ($host eq '')) {
+ 	my $s = imapaccount();
+ 	if ($s =~ /(.+)\@(.+)/) {
+ 	    $user = $1;
+ 	    $host = $2;
+ 	} elsif ($s =~ /\@(.+)/){
+ 	    $user = $ENV{'USER'} || $ENV{'LOGNAME'} || im_getlogin();
+ 	    $host = $1;
+ 	} else {
+ 	    $user = $s;
+	    $host = "localhost";
+	}
+    }    
+
     if ($auth =~ /^auth$/i) {
 	$auth = 'AUTH';
     } elsif ($auth =~ /^login$/i) {
@@ -653,7 +664,7 @@
 	im_warn("unknown authentication protocol: $auth\n");
 	return ('', '', '', '');
     }
-
+    im_notice("folder=$folder auth=$auth user=$user host=$host\n");
     return ($folder, $auth, $user, $host);
 }