[Mew-dist 03641] supporting Message/partial patch
SAKAI Kiyotaka
ksakai at example.com
1998年 2月 3日 (火) 20:41:13 JST
Mew で Message/partial をサポートするためのパッチです。
添付の imjoin をインストールして、Mew にパッチを当てて使って下さい。
仕様としては、
1. @ で複数のマークを付けて "J" を押したときは、マークを付けたメールが
Message/partial を構成するすべてのメールと判断して、1つのメールにま
とまめる。
2. @ でマークを付けたメールが 1つ、または何もマークを付けていないとき
に "J" を押した場合は、history データベースにアクセスして、
Message/partial を構成する他のメールを取得し、1つのメールにまとめる。
という仕様にするつもりだったのですが、2 の方はうまく動きません。imcat
の --join オプションもうまく動作しませんので、history の方で何か問題が
あるのかもしれません。
現在は "J" を押したときに入力したフォルダにメールをまとめるだけの動作
を行いますが、本当はその時点で Message に表示するべきなのかもしれませ
ん。
ただ、現状では imcat の出力をそのまま cache するのは難しく、ニュースの
統合でも同じことを考える必要がありますので、そのときに考えることかな、
と思っています。
--
酒井 清隆 (E-mail: ksakai at example.com)
-------------- next part --------------
#!/usr/local/bin/perl
################################################################
###
### imjoin
###
### Copyright (C) 1997 Internet Message Group
###
### This Perl5 library conforms
### GNU GENERAL PUBLIC LICENSE Version 2.
###
###
### Author: Internet Message Group <img at example.com>
### Created: May 5, 1997
### Revised: @im_revised@
###
my $VERSION = "imjoin version 980128";
$Prog = 'imjoin';
##
## Require packages
##
use IM::MsgStore qw(store_message);
use IM::Config;
use IM::Util;
use integer;
use strict;
use vars qw($Prog $EXPLANATION @EnvConfig @OptConfig $opt_noscan
$opt_src $opt_dst $opt_verbose $opt_debug $opt_help);
##
## Environments
##
$EXPLANATION = "
imjoin :: Join Message/partial Messages
$VERSION
Usage: imjoin [options] msg
";
@OptConfig = (
'src;F;;' => "Folder.",
'dst;s;+inbox;' => "Folder.",
'verbose;b;;' => 'With verbose messages.',
'debug;d;;' => "With debug message.",
'help;b;;' => "Show this message.",
);
##
## Profile and option processing
##
init_opt(\@OptConfig);
read_env(\@EnvConfig);
read_cfg();
read_opt(\@ARGV); # help?
help($EXPLANATION) && exit $EXIT_SUCCESS if $opt_help;
debug_option($opt_debug) if $opt_debug;
##
## Main
##
my @msgs = @ARGV;
my $msg = $msgs[0];
$opt_noscan = 1;
my @Message = join_msg(@msgs);
if ($opt_dst eq "stdout") {
print join('', @Message);
} else {
store_message(\@Message, $opt_dst);
}
exit $EXIT_SUCCESS;
sub join_msg ($) {
my @msgs = @_;
my @paths;
my @index;
my @Message;
local $_;
if ($#msgs == 0) {
# search partial messages using history_db
@paths = get_paths("$opt_src/$msgs[0]");
} else {
# all partial message is specified by command line
require IM::Folder && import IM::Folder qw(message_name);
my $msg;
foreach $msg (@msgs) {
push(@paths, message_name($opt_src, $msg));
}
}
# sort each part number on each part
my $total = 0;
my ($path, $header);
foreach $path (@paths) {
if (open(MSG, "<$path")) {
$/ = "\n\n";
$header = <MSG>;
$/ = "\n";
close(MSG);
}
$header =~ s/\n\s+//g;
$header =~ s/[ \t]+//g;
$header =~ s/\n/;\n/g;
$header = "\n$header";
my $number = 0;
my $this_total = 0;
if ($header =~ /\nContent-Type:Message\/partial(;[^\n]+)\n/i) {
my $rest = $1;
if ($rest =~ /;number=(\d+);/i) {
$number = $1;
}
if ($rest =~ /;total=(\d+);/i) {
$this_total = $1;
}
}
if ($number == 0 || $this_total == 0) {
im_warn("$_: not a partial message, skipping.\n");
next;
}
if ($total) {
if ($total != $this_total) {
im_warn("$_: total of partial messages mismatch, skipping.\n");
next;
}
} else {
$total = $this_total;
}
$index[$number] = $path;
im_notice("$path is part $number.\n");
}
# check existance of all partial messages
my $missing = 0;
my $i;
for ($i = 1; $i <= $#index; $i++) {
if ($index[$i] eq '') {
im_err("part $i is missing.\n");
exit $EXIT_SUCCESS;
}
}
# show in sequence
for ($i = 1; $i <= $#index; $i++) {
if (open(MSG, "<$index[$i]")) {
$/ = "\n\n";
if ($i == 1) {
my $header = <MSG>;
my $skip = 0;
foreach (split("\n", $header)) {
next if (/^[ \t]/ && $skip);
$skip = 0;
if (/^(Content|Message-ID)/i) {
$skip = 1;
next;
}
last if (/^\n/);
push (@Message, "$_\n");
}
} else {
# skip header part
<MSG>;
}
$/ = "\n";
while (<MSG>) {
push(@Message, $_);
}
close(MSG);
}
}
return @Message;
}
sub get_paths ($) {
my $msg = shift;
my $path;
local $_;
unless (msgdbfile()) {
im_die("need history database to join by one message.\n");
exit $EXIT_ERROR;
}
require IM::History;
import IM::History qw(history_open history_lookup history_close);
# get master Message-ID
my $header = '';
foreach (split(',', $msg)) {
if (/^\+/) {
$path = &expand_path($_);
} else {
$path = $_;
}
if (open(MSG, "<$path")) {
$/ = "\n\n";
$header = <MSG>;
$/ = "\n";
close(MSG);
last;
}
}
if ($header eq '') {
im_err("specified message is not found at $path.\n");
exit $EXIT_ERROR;
}
$header =~ s/\n\s+//g;
$header =~ s/[ \t]+//g;
$header =~ s/\n/;\n/g;
$header = "\n$header";
my $master = '';
if ($header =~ m|\nContent-Type:Message/partial;(.*;)?id=([^;]+);|i) {
$master = $2;
$master =~ s/^"(.*)"$/$1/;
} else {
im_err("specified message is not a partial.\n");
exit $EXIT_ERROR;
}
im_notice("Master Message-ID: $master.\n");
# get Message-IDs of partial
if (history_open(0) < 0) {
im_err("can not open history.\n");
exit $EXIT_ERROR;
}
my $ids = history_lookup("partial:$master", 'LookUpMsg');
if ($ids eq '') {
im_err("information on partial messages is not found in history.\n");
exit $EXIT_ERROR;
}
im_notice("partial Message-IDs: $ids.\n");
# get path and part number on each part
my @paths;
foreach (split(',', $ids)) {
my $locate = history_lookup($_, 'LookUpMsg');
if ($locate eq '') {
im_warn("message $_ not found, skipping.\n");
next;
}
my $path = &expand_path($locate);
if ($path eq '') {
im_warn("no path for message $locate, skipping.\n");
next;
}
push(@paths, $path);
}
history_close();
return @paths;
}
### Local Variables:
### mode: perl
### End:
-------------- next part --------------
Index: mew-summary.el
===================================================================
RCS file: /home/cvsroot/mew-1.93b12/mew-summary.el,v
retrieving revision 1.3
diff -u -r1.3 mew-summary.el
--- mew-summary.el 1998/02/02 02:25:17 1.3
+++ mew-summary.el 1998/02/03 10:35:49
@@ -115,6 +115,7 @@
(define-key mew-summary-mode-map "P" 'mew-summary-display-review-up)
(define-key mew-summary-mode-map "w" 'mew-summary-send)
(define-key mew-summary-mode-map "B" 'mew-summary-burst)
+ (define-key mew-summary-mode-map "J" 'mew-summary-join)
(define-key mew-summary-mode-map "Z" 'mew-status-update)
(define-key mew-summary-mode-map "#" 'mew-summary-print)
(define-key mew-summary-mode-map "|" 'mew-summary-pipe-message)
@@ -2013,6 +2014,27 @@
mstr (1- m) folder)
(if mew-touch-folder-p (mew-touch-folder folder))
))))))))
+
+;;
+;; Join message/partial message
+;;
+(defun mew-summary-join ()
+ (interactive)
+ (let ((fld-msg (or (mew-summary-mark-collect2 mew-mark-multi)
+ (list (mew-current-get 'message))))
+ (folder (mew-input-folder mew-inbox-folder))
+ fld msgs)
+ (if fld-msg
+ (progn
+ (setq fld (car (car fld-msg)))
+ (setq msgs (mapcar 'cdr fld-msg)))
+ (setq fld (car (mew-current-get 'message)))
+ (setq msgs (cdr (mew-current-get 'message))))
+ (message "Joining marked messages to %s ..." fld)
+ (apply 'mew-im-call-process mew-prog-imjoin
+ (format "--src=%s" fld) (format "--dst=%s" folder) msgs)
+ (message "Joining marked messages to %s ... done" fld)
+ ))
(defun mew-summary-kill-subprocess ()
"Kill a process in Summary mode such as 'imget' and 'imls'.
Index: mew-vars.el
===================================================================
RCS file: /home/cvsroot/mew-1.93b12/mew-vars.el,v
retrieving revision 1.1.1.1
diff -u -r1.1.1.1 mew-vars.el
--- mew-vars.el 1998/01/30 05:45:38 1.1.1.1
+++ mew-vars.el 1998/02/03 10:18:52
@@ -177,6 +177,7 @@
(defvar mew-prog-imsort "imsort")
(defvar mew-prog-imstore "imstore")
(defvar mew-prog-imgrep "imgrep")
+(defvar mew-prog-imjoin "imjoin")
(defvar mew-prog-mime-encode "mewencode")
(defvar mew-prog-mime-decode "mewdecode")
(defvar mew-prog-unshar "unshar")
Mew-dist メーリングリストの案内