[Mew-dist 1160] imsort + patch (Re: IM official patch 1)
ukai at example.com
ukai at example.com
1997年 7月 2日 (水) 13:29:54 JST
IM official patch 1 に対する patch にしてみました。
imsort α version
RFC2047ってこういうパッチでいいんでしょうか? (IM/MIME.pm.in)
Nntp.pm と Scan.pm で while ($_ = <HANDLE>) {} とかしてましたが
perl -cw で「"0" がきたら終わる」とかいわれたので変えました。
From: FUJIMOTO Kensaku / 藤本謙作 <fujimoto at example.com>
Subject: [Mew-dist 1148] requests for IM::Scan (Re: imsort-alpha )
Date: Wed, 02 Jul 1997 03:53:16 +0900
> get_headerの中で加工したものは、
> 元の名前でなく、例えば
> $Head{'date:monmday}
> とかなんとか、
> 別の名前に格納する方がよくないですか。
私もその方がいいように思います。
--
鵜飼文敏
-------------- next part --------------
diff -Nru im-40p1.orig/IM.in/Date.pm.in im-40p1/IM.in/Date.pm.in
--- im-40p1.orig/IM.in/Date.pm.in Thu Jan 1 09:00:00 1970
+++ im-40p1/IM.in/Date.pm.in Wed Jul 2 13:12:59 1997
@@ -0,0 +1,133 @@
+## Date.pm
+## Copyright (c) 1997 UKAI Fumitoshi
+##
+my $VERSION = "IM:Date.pm @im_cv_version@";
+
+package IM::Date;
+require Exporter;
+
+use IM::Config;
+use IM::Debug;
+use IM::ErrorReport;
+
+use Time::Local;
+
+ at example.com = qw(Exporter);
+ at example.com = qw(datetm);
+
+=head1 NAME
+
+Date - RFC822 style date parser
+
+=head1 SYNOPSIS
+
+ use IM::Date;
+
+ $t = datetm($datefield);
+
+ ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
+ localtime($t);
+
+=head1 DESCRIPTION
+
+ datetm returns a time as returned by the time function,
+ the number of non-leap seconds since whatever time the
+ system considers to be the epoch (that's 00:00:00 UTC, January 1,
+ 1970.)
+
+=cut
+
+ at example.com = ('Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat', 'Sun');
+$dstrpat = join('|', @dstrs);
+ at example.com = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
+ 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
+$mstrpat = join('|', @mstrs);
+
+%zone = (
+ 'UT' => 0,
+ 'GMT' => 0,
+ 'EST' => (-5 * 60),
+ 'EDT' => (-4 * 60),
+ 'CST' => (-6 * 60),
+ 'CDT' => (-5 * 60),
+ 'MST' => (-7 * 60),
+ 'MDT' => (-6 * 60),
+ 'PST' => (-8 * 60),
+ 'PDT' => (-7 * 60),
+ 'JST' => (9 * 60), # non-standard, but used by old(?) mailer
+ );
+
+$zonepat = join('|', keys %zone, 'A-Z', '[-+]\d{4}');
+
+sub datetm {
+ my ($d) = @_;
+ my $date = {};
+ $d =~ s/\(.*?\)/ /g; # remove comments
+ $d =~ s/\n/ /g;
+ if ($d =~ s/^\s*($dstrpat)\s*,\s*//i) {
+ $date->{'wday'} = $1;
+ }
+
+ if ($d =~ /^\s*(\d{1,2})\s+($mstrpat)\s+(\d{2,4})\s+(\d{2}):(\d{2}):(\d{2})\s+(\S*)\s*$/i) {
+ $date->{'mday'} = $1;
+ $date->{'mon'} = &mstr2num($2);
+ $date->{'year'} = $3;
+ $date->{'hours'} = $4;
+ $date->{'min'} = $5;
+ $date->{'sec'} = $6;
+ my $tz = $7;
+ if ($tz =~ /$zonepat/) {
+ $date->{'tzoffset'} = &tz2num($tz);
+ } else {
+ $date->{'tzoffset'} = 0; # XXX
+ }
+ } else {
+ &error_log(0, "illegal format for date: $d\n");
+ return 0;
+ }
+ return timegm($date->{'sec'}, $date->{'min'}, $date->{'hours'},
+ $date->{'mday'}, $date->{'mon'}-1, $date->{'year'})
+ - ($date->{'tzoffset'} * 60);
+}
+
+sub mstr2num {
+ my ($mstr) = @_;
+ my ($m) = 1;
+ foreach (@mstrs) {
+ if ($mstr =~ /$_/i) {
+ return $m;
+ }
+ ++$m;
+ }
+ return 0; # /* illegal? */
+}
+
+sub tz2num {
+ my ($tzstr) = @_;
+
+ $tzstr = ucfirst(lc($tzstr));
+
+ if (defined($zone{$tzstr})) {
+ return $zone{$tzstr};
+ } elsif ($tzstr =~ /A-Z/) {
+ my ($m) = ord($tzstr);
+
+ if ($m == ord('Z')) {
+ return 0;
+ } elsif ($m < ord('J')) {
+ return -1 * ($m - ord('A') + 1) * 60;
+ } elsif ($m < ord('M')) {
+ return -1 * ($m - ord('A')) * 60;
+ } else {
+ return ($m - ord('M')) * 60;
+ }
+ } elsif ($tzstr =~ /([+-])(\d{2})(\d{2})/) {
+ my $sign = 1;
+ $sign = ($1 eq '+') ? 1 : -1;
+ return $sign * $2 * 60 + $3;
+ }
+ return 0; # ??
+}
+
+1;
+
diff -Nru im-40p1.orig/IM.in/MIME.pm.in im-40p1/IM.in/MIME.pm.in
--- im-40p1.orig/IM.in/MIME.pm.in Wed Jul 2 13:03:32 1997
+++ im-40p1/IM.in/MIME.pm.in Wed Jul 2 13:09:13 1997
@@ -160,13 +160,23 @@
return $nstr;
}
+sub mime_decode_encoded_word {
+ my ($charset, $e, $str) = @_;
+ if ($$mime_decode_switch{uc($e)}) {
+ $str = &{$$mime_decode_switch{uc($e)}}($str);
+ } else {
+ ;# XXX
+ $str = '=?' . $charset . '?' . $e . '?' . $str . '?=';
+ }
+ return $str;
+}
+
sub mime_decode_string {
my($in) = (@_);
- while ($in =~ /^(.*)=\?([^?]+)\?(.)\?([^?]+)\?=(.*)$/) {
- if ($$mime_decode_switch{uc($3)}) {
- $in = $1 . &{$$mime_decode_switch{uc($3)}}($4) . $5;
- }
- }
+ my ($ewpat) = '=\?([^?]+)\?(.)\?([^?]+)\?=';
+
+ $in =~ s/($ewpat)[\n\s]+($ewpat)/$1$5/ig;
+ $in =~ s/$ewpat/&mime_decode_encoded_word($1,$2,$3)/ige;
return $in;
}
diff -Nru im-40p1.orig/IM.in/Nntp.pm.in im-40p1/IM.in/Nntp.pm.in
--- im-40p1.orig/IM.in/Nntp.pm.in Fri Jun 27 23:17:43 1997
+++ im-40p1/IM.in/Nntp.pm.in Wed Jul 2 13:09:42 1997
@@ -344,7 +344,7 @@
my $newshist = &expand_path("$main::opt_newshistory-$server");
if ( -f $newshist ) {
open (NEWSHIST, "+<$newshist");
- while ($pos = tell(NEWSHIST), $_ = <NEWSHIST>) {
+ while ($pos = tell(NEWSHIST), defined($_ = <NEWSHIST>)) {
/^([\w\.\-]+):/;
if ($group eq $1) {
$last = $';
diff -Nru im-40p1.orig/IM.in/Scan.pm.in im-40p1/IM.in/Scan.pm.in
--- im-40p1.orig/IM.in/Scan.pm.in Wed Jul 2 13:03:32 1997
+++ im-40p1/IM.in/Scan.pm.in Wed Jul 2 13:12:01 1997
@@ -149,11 +149,11 @@
## Header parse
##
$lines = 1;
- $field = <MSG>;
- HEAD: while ($_ = <MSG>) {
+ chomp($field = <MSG>);
+ HEAD: while (<MSG>) {
chomp;
if (/^\s+/) {
- s/^\s+//;
+ s/^\s+/ /;
$field = $field . $_;
next;
}
@@ -176,7 +176,7 @@
##
$lines = 0;
$body = '';
- BODY: while ($_ = <MSG>) {
+ BODY: while (<MSG>) {
next BODY if /^#/;
next BODY if /^\s*\n/;
next BODY if /^--/;
@@ -222,6 +222,9 @@
##
## Date
##
+ ## XXX: save original date
+ $Head{'date:'} = $Head{'date'};
+
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
localtime((stat($path))[9]);
my $stamp = sprintf "%s%d/%s%d*",
diff -Nru im-40p1.orig/Makefile.in im-40p1/Makefile.in
--- im-40p1.orig/Makefile.in Mon Jun 30 16:56:24 1997
+++ im-40p1/Makefile.in Wed Jul 2 13:22:11 1997
@@ -52,6 +52,7 @@
$(INSTALL) -m 555 imput $(bindir)
$(INSTALL) -m 555 imrm $(bindir)
$(INSTALL) -m 555 imsetup $(bindir)
+ $(INSTALL) -m 555 imsort $(bindir)
$(INSTALL) $(RPOP) imget $(bindir)
installdata::
@@ -68,7 +69,7 @@
clean::
$(rm) -f imali imcat imcd imrm imget imgrep imls immv \
- impack impath imput imsetup
+ impack impath imput imsetup imsort
$(rm) -rf IM
$(mkdir) IM
diff -Nru im-40p1.orig/configure im-40p1/configure
--- im-40p1.orig/configure Tue Jul 1 12:48:27 1997
+++ im-40p1/configure Wed Jul 2 13:17:43 1997
@@ -1023,11 +1023,12 @@
trap 'rm -fr `echo "imali:imali.in imcat:imcat.in imcd:imcd.in \
imget:imget.in imgrep:imgrep.in imls:imls.in immv:immv.in \
impack:impack.in impath:impath.in imput:imput.in \
- imrm:imrm.in imsetup:imsetup.in \
+ imrm:imrm.in imsetup:imsetup.in imsort:imsort.in \
Makefile:Makefile.in \
IM/Address.pm:IM.in/Address.pm.in \
IM/Alias.pm:IM.in/Alias.pm.in \
IM/Config.pm:IM.in/Config.pm.in \
+ IM/Date.pm:IM.in/Date.pm.in \
IM/Debug.pm:IM.in/Debug.pm.in \
IM/EncDec.pm:IM.in/EncDec.pm.in \
IM/ErrorReport.pm:IM.in/ErrorReport.pm.in \
@@ -1143,11 +1144,12 @@
CONFIG_FILES=\${CONFIG_FILES-"imali:imali.in imcat:imcat.in imcd:imcd.in \
imget:imget.in imgrep:imgrep.in imls:imls.in immv:immv.in \
impack:impack.in impath:impath.in imput:imput.in \
- imrm:imrm.in imsetup:imsetup.in \
+ imrm:imrm.in imsetup:imsetup.in imsort:imsort.in\
Makefile:Makefile.in \
IM/Address.pm:IM.in/Address.pm.in \
IM/Alias.pm:IM.in/Alias.pm.in \
IM/Config.pm:IM.in/Config.pm.in \
+ IM/Date.pm:IM.in/Date.pm.in \
IM/Debug.pm:IM.in/Debug.pm.in \
IM/EncDec.pm:IM.in/EncDec.pm.in \
IM/ErrorReport.pm:IM.in/ErrorReport.pm.in \
@@ -1236,7 +1238,7 @@
EOF
cat >> $CONFIG_STATUS <<\EOF
chmod 555 imali imcat imcd imget imgrep \
- imls immv impack impath imput imrm imsetup
+ imls immv impack impath imput imrm imsetup imsort
exit 0
EOF
chmod +x $CONFIG_STATUS
diff -Nru im-40p1.orig/imsort.in im-40p1/imsort.in
--- im-40p1.orig/imsort.in Thu Jan 1 09:00:00 1970
+++ im-40p1/imsort.in Wed Jul 2 13:13:56 1997
@@ -0,0 +1,126 @@
+#! @im_cv_path_perl@
+# Copyright (c) 1997 UKAI Fumitoshi
+#
+
+my $VERSION = "imsort @im_cv_version@";
+$Prog = 'imsort';
+
+use IM::Config;
+use IM::Scan;
+use IM::Date;
+
+$EXPLANATION = "
+$Prog :: Internet Message Sort
+$VERSION
+
+Usage :: $Prog [options] [+folder] [range]
+";
+
+ at example.com = (
+ 'src;F@;;' => 'Message source',
+ 'noharm;b;;' => 'No sorting. Show what will happen.',
+ 'help;b;;' => 'Show this message',
+);
+
+init_opt(\@OptConfig);
+read_env(\@EnvConfig);
+read_cfg();
+read_opt(\@ARGV);
+help($EXPLANATION) && exit $EXIT_SUCCESS if ($opt_help);
+
+ at example.com = ('all') if $#ARGV == -1;
+ at example.com = &uniq(@opt_src);
+
+if (scalar(@opt_src) < 1) {
+ im_die("must specify one or more folders.\n");
+} else {
+ if (scalar(@opt_src) != 1) {
+ im_die("must specify just one folder.\n");
+ }
+ $_ = $opt_src[0];
+ if (/^[+=]/) {
+ require IM::Folder && import IM::Folder;
+ &local_files($_, @ARGV);
+ } else {
+ im_die("doesn't support $opt_src\n");
+ }
+ exit $EXIT_SUCCESS;
+}
+
+sub local_files {
+ my ($folder) = shift;
+ my (@arg) = @_;
+ my (%Head) = ();
+ my ($num);
+ my (%date, @list, @sorted) = ();
+
+ foreach $num (get_message_paths($folder, @arg)) {
+ if (-f $num) {
+ %Head = &get_header($num);
+ $date{$num} = datetm($Head{'date:'});
+ push(@list, $num);
+ # print "$num $Head{'date:'} $Head{'date'} $date{$num}\n";
+ }
+ }
+
+ @sorted = sort {$date{$a} <=> $date{$b}} keys %date;
+ &renumber_messages(\@sorted, \@list);
+}
+
+;# renumber @{$cur} to @{$new}
+sub renumber_messages {
+ my ($cur, $new) = @_;
+ my (%tmp);
+ my ($n);
+
+ if ($#{$cur} != $#{$new}) {
+ im_die("array size not match $#{$cur} != $#{$new}\n");
+ }
+
+ foreach (@{$cur}) {
+ $tmp{$_} = $_;
+ }
+
+ ;# cur[$n]: current nth filename
+ ;# new[$n]: desired nth filename
+ ;# tmp{$num}: actual current $num's filename
+
+ for ($n = 0; $n <= $#{$cur}; $n++) {
+ if ($cur->[$n] ne $new->[$n]) {
+ ;# $cur->[$n] should be renamed to $new->[$n]
+
+ if (defined($tmp{$new->[$n]})) {
+ # but $new->[$n] still exits, so save as .tmp
+ # record this file is now .tmp
+ $tmp{$new->[$n]} .= '.tmp';
+ &renamefile($new->[$n], $tmp{$new->[$n]});
+ }
+ # at this point, $new->[$n] is no longer exists (already moved)
+ # or move to .tmp now, so we can rename $cur->[$n] to $new->[$n]
+
+ &renamefile($tmp{$cur->[$n]}, $new->[$n]);
+ # mark $cur->[$n] is done, moved to $new->[$n]
+ delete $tmp{$cur->[$n]};
+ }
+ }
+}
+
+sub renamefile {
+ my ($a, $b) = @_;
+
+ if ($opt_noharm) {
+ print "mv $a $b\n";
+ } else {
+ rename($a, $b) || die;
+ }
+}
+
+sub uniq {
+ my @array = @_;
+ my %hash;
+
+ foreach (@array) {
+ $hash{$_} = $_;
+ }
+ return keys %hash;
+}
Mew-dist メーリングリストの案内