2 ##--------------------------------------------------------------------------##
4 ## $Id: mbox-month-pack,v 1.4 2002/09/15 03:33:08 ehood Exp $
6 ## See POD below or run program with -man option.
7 ##--------------------------------------------------------------------------##
8 ## Copyright (C) 2002 Earl Hood <earl@earlhood.com>
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.
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.
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
24 ##--------------------------------------------------------------------------##
26 package MHArc
::mbox_month_pack
;
28 ##--------------------------------------------------------------------------##
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
34 ##--------------------------------------------------------------------------##
37 my $config = MHArc
::Config
->load("$Dir/../lib/config.sh");
39 ##--------------------------------------------------------------------------##
43 use MHArc
::Util
qw( usage );
45 # For MHonArc date/time utilities and message head parsing
57 my $msgsep = '^From ';
61 mhonarc
::initialize
();
62 mhonarc
::open_archive
('-noarg', '-quiet') ||
63 die qq/ERROR: Unable to load MHonArc library\n/;
64 mhonarc
::close_archive
();
66 # Grap command-line options
67 my $clstatus = GetOptions
(
69 "msgsep=s" => \
$msgsep,
70 "outdir=s" => \
$outdir,
71 "verbose!" => \
$verbose,
72 "yearly!" => \
$yearly,
77 usage
(0) unless $clstatus;
81 $verbose = 1 if $noop;
82 $verbose = 1 if $debug;
84 push(@ARGV, '-') if (!@ARGV);
87 select(STDOUT
); $| = 1;
91 my($fh, $sep, $header, $fields, $body, $mon, $yr);
94 MBOX
: foreach $mbox (@ARGV) {
95 print qq/Processing mbox "$mbox"/ if $verbose;
100 if (!open(MBOX
, $mbox)) {
101 warn qq/Warning: Unable to open "$mbox": $!\n/;
107 print qq/Debug: Scanning for first separator/ if $debug;
116 while (defined($sep)) {
117 print '.' if $verbose && !$debug;
119 # Grab message header and date.
120 ($fields, $header) = read_mail_header
($fh);
121 #dump_header(\*STDOUT, $fields) if $debug;
123 print qq/Debug: separator=$sep/ if $debug;
125 @date = mhonarc
::parse_date
($sep);
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]);
141 print qq/Debug: \@date=/, join('|',@date), qq/\n/ if $debug;
144 (localtime(mhonarc
::get_time_from_date
(@date[1..$#date])))[4,5];
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];
156 print qq/Debug: year=$yr, month=$mon\n/ if $debug;
158 $sep = dump_to_mbox
($fh, $yr, $mon, $sep, $header);
162 print "\n" if $verbose;
168 ##--------------------------------------------------------------------------##
170 sub read_mail_header
{
171 readmail
::MAILread_file_header
(@_);
178 # rest of arguments comprise the header
180 my $out_file = join('/', $outdir,
181 ($yearly ?
sprintf("%04d", $yr) :
182 sprintf("%04d-%02d", $yr, $mon)));
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;
189 # Print separator/header
209 my($key, $a, $value);
210 foreach $key (sort keys %$fields) {
211 $a = $fields->{$key};
213 foreach $value (@
$a) {
214 print $fh "$key: $value\n";
217 print $fh "$key: $a\n";
223 ##--------------------------------------------------------------------------##
228 mbox-month-pack - Copy mailbox messages into monthly mailbox files.
232 mbox-month-pack [options] folder ...
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.
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.
254 Like C<-verbose>, but prints much more.
258 Print out help message.
262 Print out the manpage.
264 =item C<-outdir> I<directory>
266 Directory to place mailbox files. If not specified, the
267 current working directory is used.
271 Print status of what is going on.
275 Generate yearly-based mailbox files instead of monthly-based.
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.
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:
294 prompt> mbox-month-pack mail.mbx
295 prompt> mbox-month-pack mail.mbx
297 The resulting monthly mailbox files will contain two of each message.
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.
310 $Id: mbox-month-pack,v 1.4 2002/09/15 03:33:08 ehood Exp $
314 Earl Hood, earl@earlhood.com
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