Commit | Line | Data |
---|---|---|
2ea8f66b IK |
1 | #!/usr/bin/perl |
2 | ##--------------------------------------------------------------------------## | |
3 | ## File: | |
4 | ## $Id: mbox-month-pack,v 1.4 2002/09/15 03:33:08 ehood Exp $ | |
5 | ## Description: | |
6 | ## See POD below or run program with -man option. | |
7 | ##--------------------------------------------------------------------------## | |
8 | ## Copyright (C) 2002 Earl Hood <earl@earlhood.com> | |
9 | ## | |
10 | ## This program is free software; you can redistribute it and/or modify | |
11 | ## it under the terms of the GNU General Public License as published by | |
12 | ## the Free Software Foundation; either version 2 of the License, or | |
13 | ## (at your option) any later version. | |
14 | ## | |
15 | ## This program is distributed in the hope that it will be useful, | |
16 | ## but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ## GNU General Public License for more details. | |
19 | ## | |
20 | ## You should have received a copy of the GNU General Public License | |
21 | ## along with this program; if not, write to the Free Software | |
22 | ## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | |
23 | ## 02111-1307, USA | |
24 | ##--------------------------------------------------------------------------## | |
25 | ||
26 | package MHArc::mbox_month_pack; | |
27 | ||
28 | ##--------------------------------------------------------------------------## | |
29 | # <x-boot-strap> | |
30 | BEGIN { die qq/CGI use FORBIDDEN!\n/ if (defined($ENV{'GATEWAY_INTERFACE'})); } | |
31 | my $Dir; BEGIN { $Dir = `dirname $0`; chomp $Dir; } | |
32 | use lib "$Dir/../lib"; # Add relative lib to search path | |
33 | # </x-boot-strap> | |
34 | ##--------------------------------------------------------------------------## | |
35 | # <x-config> | |
36 | use MHArc::Config; | |
37 | my $config = MHArc::Config->load("$Dir/../lib/config.sh"); | |
38 | # </x-config> | |
39 | ##--------------------------------------------------------------------------## | |
40 | ||
41 | ||
42 | use Getopt::Long; | |
43 | use MHArc::Util qw( usage ); | |
44 | ||
45 | # For MHonArc date/time utilities and message head parsing | |
46 | require 'mhamain.pl'; | |
47 | ||
48 | my $debug = 0; | |
49 | my $verbose = 0; | |
50 | my $noop = 0; | |
51 | my $noanno = 0; | |
52 | my $all = 0; | |
53 | ||
54 | my $outdir = '.'; | |
55 | my $yearly = 0; | |
56 | ||
57 | my $msgsep = '^From '; | |
58 | ||
59 | MAIN: { | |
60 | # Load mhonarc code | |
61 | mhonarc::initialize(); | |
62 | mhonarc::open_archive('-noarg', '-quiet') || | |
63 | die qq/ERROR: Unable to load MHonArc library\n/; | |
64 | mhonarc::close_archive(); | |
65 | ||
66 | # Grap command-line options | |
67 | my $clstatus = GetOptions( | |
68 | "debug!" => \$debug, | |
69 | "msgsep=s" => \$msgsep, | |
70 | "outdir=s" => \$outdir, | |
71 | "verbose!" => \$verbose, | |
72 | "yearly!" => \$yearly, | |
73 | ||
74 | "help" => \$help, | |
75 | "man" => \$man | |
76 | ); | |
77 | usage(0) unless $clstatus; | |
78 | usage(1) if $help; | |
79 | usage(2) if $man; | |
80 | ||
81 | $verbose = 1 if $noop; | |
82 | $verbose = 1 if $debug; | |
83 | ||
84 | push(@ARGV, '-') if (!@ARGV); | |
85 | ||
86 | if ($verbose) { | |
87 | select(STDOUT); $| = 1; | |
88 | } | |
89 | ||
90 | local(*MBOX, $_); | |
91 | my($fh, $sep, $header, $fields, $body, $mon, $yr); | |
92 | my @date; | |
93 | ||
94 | MBOX: foreach $mbox (@ARGV) { | |
95 | print qq/Processing mbox "$mbox"/ if $verbose; | |
96 | ||
97 | if ($mbox eq '-') { | |
98 | $fh = \*STDIN; | |
99 | } else { | |
100 | if (!open(MBOX, $mbox)) { | |
101 | warn qq/Warning: Unable to open "$mbox": $!\n/; | |
102 | next MBOX; | |
103 | } | |
104 | $fh = \*MBOX; | |
105 | } | |
106 | ||
107 | print qq/Debug: Scanning for first separator/ if $debug; | |
108 | $sep = undef; | |
109 | while (<$fh>) { | |
110 | if (/$msgsep/o) { | |
111 | $sep = $_; | |
112 | last; | |
113 | } | |
114 | } | |
115 | ||
116 | while (defined($sep)) { | |
117 | print '.' if $verbose && !$debug; | |
118 | ||
119 | # Grab message header and date. | |
120 | ($fields, $header) = read_mail_header($fh); | |
121 | #dump_header(\*STDOUT, $fields) if $debug; | |
122 | ||
123 | print qq/Debug: separator=$sep/ if $debug; | |
124 | if ($use_sep_date) { | |
125 | @date = mhonarc::parse_date($sep); | |
126 | } else { | |
127 | @date = ( ); | |
128 | } | |
129 | ||
130 | ||
131 | if (!@date) { | |
132 | if (defined($fields->{'received'})) { | |
133 | my @ra = split(/;/, $fields->{'received'}[0]); | |
134 | print qq/Debug: Received date=$ra[-1]\n/ if $debug; | |
135 | @date = mhonarc::parse_date(pop(@ra)); | |
136 | } elsif (defined($fields->{'date'})) { | |
137 | @date = mhonarc::parse_date($fields->{'date'}[0]); | |
138 | } | |
139 | } | |
140 | ||
141 | print qq/Debug: \@date=/, join('|',@date), qq/\n/ if $debug; | |
142 | if (@date) { | |
143 | ($mon, $yr) = | |
144 | (localtime(mhonarc::get_time_from_date(@date[1..$#date])))[4,5]; | |
145 | ++$mon; | |
146 | $yr += 1900; | |
147 | ||
148 | } else { | |
149 | warn qq/Warning: No date found for message, using current\n/, | |
150 | qq/ Message-Id: /, $fields->{'message-id'}[0], qq/\n/, | |
151 | qq/ Subject: /, $fields->{'subject'}[0], qq/\n/; | |
152 | ($mon, $yr) = (localtime(time))[4,5]; | |
153 | ++$mon; | |
154 | $yr += 1900; | |
155 | } | |
156 | print qq/Debug: year=$yr, month=$mon\n/ if $debug; | |
157 | ||
158 | $sep = dump_to_mbox($fh, $yr, $mon, $sep, $header); | |
159 | ||
160 | } | |
161 | } continue { | |
162 | print "\n" if $verbose; | |
163 | } | |
164 | ||
165 | ||
166 | } # End: MAIN | |
167 | ||
168 | ##--------------------------------------------------------------------------## | |
169 | ||
170 | sub read_mail_header { | |
171 | readmail::MAILread_file_header(@_); | |
172 | } | |
173 | ||
174 | sub dump_to_mbox { | |
175 | my $fh = shift; | |
176 | my $yr = shift; | |
177 | my $mon = shift; | |
178 | # rest of arguments comprise the header | |
179 | ||
180 | my $out_file = join('/', $outdir, | |
181 | ($yearly ? sprintf("%04d", $yr) : | |
182 | sprintf("%04d-%02d", $yr, $mon))); | |
183 | ||
184 | local(*OUT); | |
185 | open(OUT, ">>$out_file") || | |
186 | die qq/ERROR: Unable to open "$out_file": $!\n/; | |
187 | print qq/Debug: Appending to "$out_file"\n/ if $debug; | |
188 | ||
189 | # Print separator/header | |
190 | print OUT @_, "\n"; | |
191 | ||
192 | # Get body | |
193 | my $body = ''; | |
194 | my $sep = undef; | |
195 | local $_; | |
196 | while (<$fh>) { | |
197 | if (/$msgsep/o) { | |
198 | $sep = $_; | |
199 | last; | |
200 | } | |
201 | print OUT $_; | |
202 | } | |
203 | $sep; | |
204 | } | |
205 | ||
206 | sub dump_header { | |
207 | my $fh = shift; | |
208 | my $fields = shift; | |
209 | my($key, $a, $value); | |
210 | foreach $key (sort keys %$fields) { | |
211 | $a = $fields->{$key}; | |
212 | if (ref($a)) { | |
213 | foreach $value (@$a) { | |
214 | print $fh "$key: $value\n"; | |
215 | } | |
216 | } else { | |
217 | print $fh "$key: $a\n"; | |
218 | } | |
219 | } | |
220 | } | |
221 | ||
222 | ||
223 | ##--------------------------------------------------------------------------## | |
224 | __END__ | |
225 | ||
226 | =head1 NAME | |
227 | ||
228 | mbox-month-pack - Copy mailbox messages into monthly mailbox files. | |
229 | ||
230 | =head1 SYNOPSIS | |
231 | ||
232 | mbox-month-pack [options] folder ... | |
233 | ||
234 | =head1 DESCRIPTION | |
235 | ||
236 | This program copies mailbox messages into monthly (or yearly if | |
237 | the C<-yearly> option is specified) mailbox files. By default, | |
238 | monthly mailbox files are created with filenames of I<YYYY-MM> format. | |
239 | If the C<-yearly> option is specified, than messages will be split | |
240 | into yearly, I<YYYY>, files. If a mailbox file already exists, | |
241 | messages will be appended to it. | |
242 | ||
243 | This program is provided as part of mharc to provide the ability to | |
244 | import existing mailbox messages into mharc archives, or as a possible | |
245 | replacement for L<filter-spool|filter-spool> for sites that have | |
246 | alternate methods for managing incoming mail. | |
247 | ||
248 | =head1 OPTIONS | |
249 | ||
250 | =over | |
251 | ||
252 | =item C<-debug> | |
253 | ||
254 | Like C<-verbose>, but prints much more. | |
255 | ||
256 | =item C<-help> | |
257 | ||
258 | Print out help message. | |
259 | ||
260 | =item C<-man> | |
261 | ||
262 | Print out the manpage. | |
263 | ||
264 | =item C<-outdir> I<directory> | |
265 | ||
266 | Directory to place mailbox files. If not specified, the | |
267 | current working directory is used. | |
268 | ||
269 | =item C<-verbose> | |
270 | ||
271 | Print status of what is going on. | |
272 | ||
273 | =item C<-yearly> | |
274 | ||
275 | Generate yearly-based mailbox files instead of monthly-based. | |
276 | ||
277 | =back | |
278 | ||
279 | =head1 DEPENDENCIES | |
280 | ||
281 | This program uses MHonArc's date parsing functions. Therefore, | |
282 | MHonArc must be installed on your system and the MHonArc libraries | |
283 | located within Perl's include path. | |
284 | ||
285 | =head1 LIMITATIONS | |
286 | ||
287 | =over | |
288 | ||
289 | =item * | |
290 | ||
291 | This program does not remember what messages it has processed. | |
292 | For example, if you run the program twice in a row like the following: | |
293 | ||
294 | prompt> mbox-month-pack mail.mbx | |
295 | prompt> mbox-month-pack mail.mbx | |
296 | ||
297 | The resulting monthly mailbox files will contain two of each message. | |
298 | ||
299 | =item * | |
300 | ||
301 | Appending to pre-existing gzipped monthly, and yearly, mailbox files | |
302 | are not recognized when splitting input. If you want output to be | |
303 | appended to existing compressed mailboxes, you must uncompress them | |
304 | first before invoking this program. | |
305 | ||
306 | =back | |
307 | ||
308 | =head1 VERSION | |
309 | ||
310 | $Id: mbox-month-pack,v 1.4 2002/09/15 03:33:08 ehood Exp $ | |
311 | ||
312 | =head1 AUTHOR | |
313 | ||
314 | Earl Hood, earl@earlhood.com | |
315 | ||
316 | This program is part of the mharc archiving system and comes with | |
317 | ABSOLUTELY NO WARRANTY and may be copied only under the terms of | |
318 | the GNU General Public License, which may be found in the mharc | |
319 | distribution. | |
320 | ||
321 | =cut | |
322 |