Mercurial > hg > Applications > mh

comparison miscellany/audit/mh.pl @ 0:bce86c4163a3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initial revision
author kono
date Mon, 18 Apr 2005 23:46:02 +0900
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:bce86c4163a3
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;