remove seemingly old useless ed
[mharc.git] / bin / mbox-month-pack
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