lists.def blocks http mboxes, unused otherwise
[mharc.git] / bin / mbox-month-pack
CommitLineData
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
26package MHArc::mbox_month_pack;
27
28##--------------------------------------------------------------------------##
29# <x-boot-strap>
30BEGIN { die qq/CGI use FORBIDDEN!\n/ if (defined($ENV{'GATEWAY_INTERFACE'})); }
31my $Dir; BEGIN { $Dir = `dirname $0`; chomp $Dir; }
32use lib "$Dir/../lib"; # Add relative lib to search path
33# </x-boot-strap>
34##--------------------------------------------------------------------------##
35# <x-config>
36use MHArc::Config;
37my $config = MHArc::Config->load("$Dir/../lib/config.sh");
38# </x-config>
39##--------------------------------------------------------------------------##
40
41
42use Getopt::Long;
43use MHArc::Util qw( usage );
44
45# For MHonArc date/time utilities and message head parsing
46require 'mhamain.pl';
47
48my $debug = 0;
49my $verbose = 0;
50my $noop = 0;
51my $noanno = 0;
52my $all = 0;
53
54my $outdir = '.';
55my $yearly = 0;
56
57my $msgsep = '^From ';
58
59MAIN: {
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
170sub read_mail_header {
171 readmail::MAILread_file_header(@_);
172}
173
174sub 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
206sub 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
228mbox-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
236This program copies mailbox messages into monthly (or yearly if
237the C<-yearly> option is specified) mailbox files. By default,
238monthly mailbox files are created with filenames of I<YYYY-MM> format.
239If the C<-yearly> option is specified, than messages will be split
240into yearly, I<YYYY>, files. If a mailbox file already exists,
241messages will be appended to it.
242
243This program is provided as part of mharc to provide the ability to
244import existing mailbox messages into mharc archives, or as a possible
245replacement for L<filter-spool|filter-spool> for sites that have
246alternate methods for managing incoming mail.
247
248=head1 OPTIONS
249
250=over
251
252=item C<-debug>
253
254Like C<-verbose>, but prints much more.
255
256=item C<-help>
257
258Print out help message.
259
260=item C<-man>
261
262Print out the manpage.
263
264=item C<-outdir> I<directory>
265
266Directory to place mailbox files. If not specified, the
267current working directory is used.
268
269=item C<-verbose>
270
271Print status of what is going on.
272
273=item C<-yearly>
274
275Generate yearly-based mailbox files instead of monthly-based.
276
277=back
278
279=head1 DEPENDENCIES
280
281This program uses MHonArc's date parsing functions. Therefore,
282MHonArc must be installed on your system and the MHonArc libraries
283located within Perl's include path.
284
285=head1 LIMITATIONS
286
287=over
288
289=item *
290
291This program does not remember what messages it has processed.
292For 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
297The resulting monthly mailbox files will contain two of each message.
298
299=item *
300
301Appending to pre-existing gzipped monthly, and yearly, mailbox files
302are not recognized when splitting input. If you want output to be
303appended to existing compressed mailboxes, you must uncompress them
304first 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
314Earl Hood, earl@earlhood.com
315
316This program is part of the mharc archiving system and comes with
317ABSOLUTELY NO WARRANTY and may be copied only under the terms of
318the GNU General Public License, which may be found in the mharc
319distribution.
320
321=cut
322