Adjust some perl & tcl related things in various scripts & utilities.
[dragonfly.git] / tools / tools / mid / mid-index
CommitLineData
52b73b16 1#!/usr/pkg/bin/perl
984263bc
MD
2#
3# create message-id / in-reply-to database
4#
5# $FreeBSD: src/tools/tools/mid/mid-index,v 1.2 1999/08/28 00:54:31 peter Exp $
1de703da 6# $DragonFly: src/tools/tools/mid/mid-index,v 1.2 2003/06/17 04:29:11 dillon Exp $
984263bc
MD
7
8sub usage { die "usage: mid-index name < filelist"; }
9
10sub id {
11 local($name, @files) = @_;
12 local($bytes, $bytes2, $headlen, $file);
13 local($counter);
14 local($from,$from2);
15
16 $counter = 0;
17 open(MID, "| sort -u -o $name.mid") || die "open sort > $name.mid: $!\n";
18 open(IRT, "| sort -u -o $name.irt") || die "open sort > $name.irt: $!\n";
19
20 while(<>) {
21 local($/) = "\n\n";
22 chop;
23 $file = $_;
24
25 open(R, $file) || do {
26 warn "open $file:$!\n";
27 next;
28 };
29 $bytes = 0;
30
31 while(<R>) {
32 $headlen = length($_);
33 $from2 = substr($_, 0, 6);
34 $from = substr($from2, 0, 5);
35
36 # warn "xxx" . $from . "yyy\n";
37 if ($from eq "From " || $from2 eq "\nFrom ") {
38
39 if ($from eq "From ") {
40 $bytes2 = $bytes;
41 } else {
42 # One bytes more for "\nFrom "
43 $bytes2 = $bytes + 1;
44 }
45
46 $counter++;
47 s/\n[ \t]+/ /g;
48 if ($debug && $counter % $speedstep == 0) {
49 print STDERR sprintf("\r%7d", $counter);
50 }
51
52 foreach (split("\n")) {
53 if (/^Message-id:\s+\<([^$idsep]+)/oi) {
54 print MID "$1 $file $bytes2\n";
55 } elsif (/^Resent-Message-id:\s+\<([^$idsep]+)/oi) {
56 print MID "$1 $file $bytes2\n";
57 } elsif (/^References:\s+\<([^$idsep]+)/oi) {
58 print IRT "$1 $file $bytes2\n";
59 } elsif (/^In-Reply-to:\s+[^<]*\<([^$idsep]+)/oi) {
60 print IRT "$1 $file $bytes2\n";
61 }
62 }
63 }
64 $bytes += $headlen;
65 }
66 close R;
67 }
68 close MID || warn "close: MID\n";
69 close IRT || warn "close: IRT\n";
70 print STDERR sprintf("\r%7d", $counter)
71 if $debug && $counter % $speedstep != 0;
72 print STDERR "\n" if $debug;
73}
74
75$idsep = '>';
76$idsep = '>@\s';
77$debug = 0;
78$speedstep = 100;
79
80&usage if $#ARGV != 0;
81$name = $ARGV[0]; shift @ARGV;
82&id($name);
83
84