Added -clobber switch to mhstore(1) [Bug #11160].
[mmh] / docs / historical / mh-6.8.5 / miscellany / audit / mh.pl
1
2
3 # =====
4 # Subroutine mh_profile
5 #       Parse the user's .mh_profile and get arguments and settings
6 #
7 sub mh_profile {
8     local($PROFILE);
9
10     ($PROFILE = $ENV{"MH"}) || ($PROFILE = $ENV{"HOME"} . "/.mh_profile");
11
12     open PROFILE || "$0: can't read mh_profile $PROFILE: $!\n";
13
14     while (<PROFILE>) {
15         next if /^#/;
16         next unless ($key, $value) = /([^:\s]+):\s*(.+)/;
17         $key =~ tr/A-Z/a-z/;
18         $MH{$key} = $value;
19     } 
20     close PROFILE;
21
22     $MH{'path'} = $ENV{'HOME'} . '/' . $MH{'path'};
23
24
25
26 # =====
27 # Subroutine rcvstore
28 #       Convenience routine for MH users. Pipes incoming
29 #       mail message to rcvstore. Expects one argument - the 
30 #       name of the folder to rcvstore into.
31 #
32 sub rcvstore {
33     local($folder) = @_;
34
35     &openpipe("/usr/local/bin/mh/lib/rcvstore +$folder -create");
36 }
37
38
39 # =====
40 # Subroutine rcvdist
41 #       Convenience routine for MH users. Pipes incoming
42 #       mail message to rcvdist. Expects one argument - the 
43 #       list of users to distribute the mail message to
44 #
45 sub rcvdist {
46     local($recips) = @_;
47
48     &openpipe("/usr/local/bin/mh/lib/rcvdist $recips");
49 }
50
51
52 # =====
53 # Subroutine rcvtty
54 #       Convenience routine for MH users. Pipes incoming
55 #       mail message to rcvtty. This is MH's version of biff.
56 #
57 sub rcvtty {
58
59     &openpipe("/usr/local/bin/mh/lib/rcvtty");
60 }
61
62
63 # =====
64 # Subroutine ali
65 #       Expand an MH alias into a list of names usable by
66 #       rcvdist
67 #
68 sub ali {
69     local($alias) = @_;
70     local($recips); 
71     local(@list) = ();
72
73     $recips = `/usr/local/bin/mh/ali $alias`;
74     chop $recips;
75     return(@list) if ($alias eq $recips);
76
77     @list = split(/,/, $recips);
78     return(@list);
79 }
80
81
82 # =====
83 # Subroutine refile_from
84 #       Refile a message into a folder by organization and 
85 #       sender name. The top-level folder is an argument
86 #       the user can specify.
87 #
88 sub refile_from {
89     local($toplevel) = @_;
90
91     return if (length($from) <= 0);
92     return if ($from eq $user);
93
94     $toplevel = "log" if ($toplevel eq '');
95     &rcvstore("$toplevel/$organization/$from");
96 }
97
98 # =====
99 # Subroutine make_mhpath
100 #       Make a directory path recursively. 
101 #
102 sub make_mhpath {
103     local($dir) = @_;
104     local($i);
105     local($mode) = 0755;
106
107     $mode = oct($MH{'folder-protect'}) if (defined $MH{'folder-protect'});
108
109     $_ = $dir;
110     s#^/.*#/# || s#^[^/].*#.#;
111     $start = $_;
112     foreach $i (split('/', $dir)) {
113         $start = $start . '/' . $i;
114         next if (-d $start);
115         mkdir($start, $mode) || return(1);
116     };
117
118     return(0);
119
120
121
122 # =====
123 # Subroutine mh_parse
124 #       Parse the command line options
125 #
126 sub mh_parse {
127     local(@argdesc) =  @SW;
128     local($wantarg);
129
130     while (($#ARGV >= 0) && ($ARGV[0] !~ /^-.+/)) { # must be a message list
131         push(@MSGS, shift @ARGV);
132     };
133
134     grep(s/(\W)/\\$1/g, @argdesc);
135
136     @ARGV = (split(' ', $MH{$program}), @ARGV) if defined($MH{$program});
137
138     return if ($#ARGV < 0);
139
140     while ($ARGV[0] =~ /^-.+/) {
141
142         $ARGV = shift @ARGV;
143
144         unless (@matches = grep(/$ARGV/, @argdesc)) {
145             print "$program: unknown option: $ARGV\n";
146             exit 1;
147             &usage;
148         } 
149
150         for (@matches) { s/\\(\W)/$1/g; } 
151
152         if ($#matches > $[) {
153             print "$program: ambiguous switch $ARGV matches:\n";
154             for (@matches) { 
155                 print "\    ", $_, "\n"; 
156             }
157             exit 1;
158         } 
159
160         ($switch,$wantarg) = $matches[$[] =~ /^-(\S+)\s*(\S*)/;
161
162         $SW{$switch} = $wantarg ? shift @ARGV : 1;
163         if ($SW{$switch} =~ /^(['"]).*$/ && $SW{$switch} !~ /^(['"]).*\1$/) {
164             do {
165                 $SW{$switch} .= ' ' . (shift @ARGV);
166             } until $#ARGV < 0 || $SW{$switch} =~ /^(['"]).*\1$/;
167             $SW{$switch} =~ s/^(['"])(.*)\1$/$2/;
168         } 
169     }
170 }
171
172
173 # =====
174 # Subroutine print_switches
175 #       print the valid command line switches
176 #
177 sub print_switches {
178     local(@argdesc) = @SW;
179
180     print "   switches are:\n";
181     for (sort @SW) {
182         print "   $_\n";
183     };
184     print "\n";
185 }
186
187
188 1;