Added -clobber switch to mhstore(1) [Bug #11160].
[mmh] / docs / historical / mh-6.8.5 / miscellany / audit / refileto
1 #!/usr/bin/perl
2
3 $program = $0;
4 $program =~ s|.*/||;
5 $| = 1;
6
7 unshift(@INC, $ENV{'DELIVERPATH'});
8 require 'audit.pl' || die "$program: cannot include audit.pl: $@";
9 require 'mh.pl' || die "$program: cannot include mh.pl: $@";
10
11 @SW = (
12         '-debug',
13         '-draft',
14         '-file file',
15         '-help',
16         '-link',
17         '-log +folder',         # defaults to +log
18         '-nolink',
19         '-nopreserve',
20         '-preserve',
21         '-rmmproc program',
22         '-src +folder',         # defaults to current folder
23         '-verbose',
24       );
25
26
27 &mh_profile();
28 &mh_parse();
29
30
31 defined($SW{'help'}) && do {
32     print "syntax: $program [msgs] [switches]\n";
33     &print_switches();
34     exit;
35 };
36
37
38 @args = (defined(@MSGS) ? @MSGS : @ARGV);
39
40
41 $logdir = $SW{'log'} || $MH{'logdir'} || "+log";
42 ($logdir = '+' . $logdir) if ($logdir !~ /\+/);
43 $folder = `mhpath cur`; chop $folder; $folder =~ s|/\d+$||;
44 $folder = $SW{'src'} if defined($SW{'src'});
45 ($folder = '+' . $folder) if ($folder !~ /\+/);
46
47
48 $SW{'file'} = "$MH{'path'}/draft" if defined($SW{'draft'});
49 if (defined($SW{'file'})) {
50     @paths = ($file);
51 } else {
52     @paths = `mhpath $folder @args`; chop @paths;
53 };
54
55
56 @refileargs = ( );
57 for ('link', 'nolink', 'preserve', 'nopreserve') {
58     push(@refileargs, "-$_") if defined($SW{$_});
59 };
60 push(@refileargs, "-rmmproc", $SW{'rmmproc'}) if defined($SW{'rmmproc'});
61
62
63 foreach $msg (@paths) {
64     open(MESSAGE, "< $msg") || next;
65
66     &local_parse_message(MESSAGE);
67
68     # -----
69     # if -from was specified use the From line; if -to is specified use
70     # the To line. 
71     #
72     $header = $headers{'from'} if ($program eq "refilefrom");
73     $header = $headers{'to'} if ($program eq "refileto");
74     $header = $header . ',' . $headers{'cc'} if 
75         (($program eq "refileto") && defined($headers{'cc'}));
76
77     @nfolders = ( ); 
78     foreach $addr (split(',', $header)) {
79        ($friendly, $address, $name, $org) = &parse_email_address($addr);
80        $org = "local" if ($org eq "unknown");
81        push(@nfolders, "$logdir/$org/$name");
82     };
83
84     @mfolders = ( );
85     foreach $folder (@nfolders) {
86        $fpath = `mhpath $folder`; chop $fpath;
87        if (-d $fpath || ! &make_mhpath($fpath)) {
88            push(@mfolders, $folder);
89        } else {
90            warn "cannot make directory $fpath: $!\n";
91        };
92     };
93
94     print "refile @refileargs -file $msg @mfolders\n" if 
95         (@mfolders && defined($SW{'verbose'}));
96     system "refile -file $msg @mfolders" if 
97         (@mfolders && !defined($SW{'debug'}));
98
99     close(MESSAGE);
100 };
101
102
103 # =====
104 # Subroutine local_parse_message
105 #       A simplified version of parse_message that does
106 #       not care about the body of the message
107 #
108 sub local_parse_message {
109     local(*INFILE) = @_;
110     local($header, $body, $mheader);
111
112     $/ = '';            # read input in paragraph mode
113     %headers = ( );
114     @received = ( );
115
116     $header = <INFILE>;
117     $/ = "\n";          
118     $* = 0;
119
120     # -----
121     # fill out the headers associative array with fields from the mail
122     # header.
123     #
124     $_ = $header;
125     s/\n\s+//g;
126     @lines = split('\n');
127     for ( @lines ) {
128         /^(\w*):\s*(.*)/ && do {
129             $mheader = $1;
130             $mheader =~ tr/A-Z/a-z/;
131             if (($mheader eq "cc" || $mheader eq "to") && $headers{$mheader}) {
132                 $headers{$mheader} .= ", $2";
133             } else {
134                 $headers{$mheader} = $2;
135             };
136         };
137     }
138
139     return;
140 }