diplodocus.org Git - nmh/blob - 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 }