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