remove archive list stylesheet

[mharc.git] / bin / mbox-month-pack

#!/usr/bin/perl
##--------------------------------------------------------------------------##
##  File:
##      $Id: mbox-month-pack,v 1.4 2002/09/15 03:33:08 ehood Exp $
##  Description:
##      See POD below or run program with -man option.
##--------------------------------------------------------------------------##
##  Copyright (C) 2002	    Earl Hood <earl@earlhood.com>
##
##  This program is free software; you can redistribute it and/or modify
##  it under the terms of the GNU General Public License as published by
##  the Free Software Foundation; either version 2 of the License, or
##  (at your option) any later version.
##
##  This program is distributed in the hope that it will be useful,
##  but WITHOUT ANY WARRANTY; without even the implied warranty of
##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##  GNU General Public License for more details.
##
##  You should have received a copy of the GNU General Public License
##  along with this program; if not, write to the Free Software
##  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
##  02111-1307, USA
##--------------------------------------------------------------------------##

package MHArc::mbox_month_pack;

##--------------------------------------------------------------------------##
# <x-boot-strap>
BEGIN { die qq/CGI use FORBIDDEN!\n/ if (defined($ENV{'GATEWAY_INTERFACE'})); }
my $Dir; BEGIN { $Dir = `dirname $0`; chomp $Dir; }
use lib "$Dir/../lib";  # Add relative lib to search path
# </x-boot-strap>
##--------------------------------------------------------------------------##
# <x-config>
use MHArc::Config;
my $config = MHArc::Config->load("$Dir/../lib/config.sh");
# </x-config>
##--------------------------------------------------------------------------##


use Getopt::Long;
use MHArc::Util qw( usage );

# For MHonArc date/time utilities and message head parsing
require 'mhamain.pl';

my $debug = 0;
my $verbose = 0;
my $noop = 0;
my $noanno = 0;
my $all = 0;

my $outdir = '.';
my $yearly = 0;

my $msgsep = '^From ';

MAIN: {
  # Load mhonarc code
  mhonarc::initialize();
  mhonarc::open_archive('-noarg', '-quiet') ||
    die qq/ERROR: Unable to load MHonArc library\n/;
  mhonarc::close_archive();

  # Grap command-line options
  my $clstatus = GetOptions(
    "debug!"      => \$debug,
    "msgsep=s"	  => \$msgsep,
    "outdir=s"	  => \$outdir,
    "verbose!"    => \$verbose,
    "yearly!"     => \$yearly,

    "help"        => \$help,
    "man"         => \$man
  );
  usage(0) unless $clstatus;
  usage(1) if $help;
  usage(2) if $man;

  $verbose = 1  if $noop;
  $verbose = 1  if $debug;

  push(@ARGV, '-')  if (!@ARGV);

  if ($verbose) {
    select(STDOUT); $| = 1;
  }

  local(*MBOX, $_);
  my($fh, $sep, $header, $fields, $body, $mon, $yr);
  my @date;

  MBOX: foreach $mbox (@ARGV) {
    print qq/Processing mbox "$mbox"/  if $verbose;

    if ($mbox eq '-') {
      $fh = \*STDIN;
    } else {
      if (!open(MBOX, $mbox)) {
	warn qq/Warning: Unable to open "$mbox": $!\n/;
	next MBOX;
      }
      $fh = \*MBOX;
    }

    print qq/Debug: Scanning for first separator/  if $debug;
    $sep = undef;
    while (<$fh>) {
      if (/$msgsep/o) {
	$sep = $_;
	last;
      }
    }

    while (defined($sep)) {
      print '.'  if $verbose && !$debug;

      # Grab message header and date.
      ($fields, $header) = read_mail_header($fh);
      #dump_header(\*STDOUT, $fields)  if $debug;

      print qq/Debug: separator=$sep/  if $debug;
      if ($use_sep_date) {
	@date = mhonarc::parse_date($sep);
      } else {
	@date = ( );
      }


      if (!@date) {
	if (defined($fields->{'received'})) {
	  my @ra = split(/;/, $fields->{'received'}[0]);
	  print qq/Debug: Received date=$ra[-1]\n/  if $debug;
	  @date = mhonarc::parse_date(pop(@ra));
	} elsif (defined($fields->{'date'})) {
	  @date = mhonarc::parse_date($fields->{'date'}[0]);
	}
      }

      print qq/Debug: \@date=/, join('|',@date), qq/\n/  if $debug;
      if (@date) {
	($mon, $yr) =
	    (localtime(mhonarc::get_time_from_date(@date[1..$#date])))[4,5];
	++$mon;
	$yr += 1900;

      } else {
	warn qq/Warning: No date found for message, using current\n/,
	     qq/         Message-Id: /, $fields->{'message-id'}[0], qq/\n/,
	     qq/         Subject: /, $fields->{'subject'}[0], qq/\n/;
	($mon, $yr) = (localtime(time))[4,5];
	++$mon;
	$yr += 1900;
      }
      print qq/Debug: year=$yr, month=$mon\n/  if $debug;

      $sep = dump_to_mbox($fh, $yr, $mon, $sep, $header);

    }
  } continue {
    print "\n"  if $verbose;
  }


} # End: MAIN

##--------------------------------------------------------------------------##

sub read_mail_header {
  readmail::MAILread_file_header(@_);
}

sub dump_to_mbox {
  my $fh     = shift;
  my $yr     = shift;
  my $mon    = shift;
  # rest of arguments comprise the header

  my $out_file = join('/', $outdir,
			   ($yearly ? sprintf("%04d", $yr) :
				      sprintf("%04d-%02d", $yr, $mon)));

  local(*OUT);
  open(OUT, ">>$out_file") ||
    die qq/ERROR: Unable to open "$out_file": $!\n/;
  print qq/Debug: Appending to "$out_file"\n/  if $debug;

  # Print separator/header
  print OUT @_, "\n";

  # Get body
  my $body  = '';
  my $sep   = undef;
  local $_;
  while (<$fh>) {
    if (/$msgsep/o) {
      $sep = $_;
      last;
    }
    print OUT $_;
  }
  $sep;
}

sub dump_header {
  my $fh      = shift;
  my $fields  = shift;
  my($key, $a, $value);
  foreach $key (sort keys %$fields) {
    $a = $fields->{$key};
    if (ref($a)) {
      foreach $value (@$a) {
	print $fh "$key: $value\n";
      }
    } else {
      print $fh "$key: $a\n";
    }
  }
}


##--------------------------------------------------------------------------##
__END__

=head1 NAME

mbox-month-pack - Copy mailbox messages into monthly mailbox files.

=head1 SYNOPSIS

  mbox-month-pack [options] folder ...

=head1 DESCRIPTION

This program copies mailbox messages into monthly (or yearly if
the C<-yearly> option is specified) mailbox files.  By default,
monthly mailbox files are created with filenames of I<YYYY-MM> format.
If the C<-yearly> option is specified, than messages will be split
into yearly, I<YYYY>, files.  If a mailbox file already exists,
messages will be appended to it.

This program is provided as part of mharc to provide the ability to
import existing mailbox messages into mharc archives, or as a possible
replacement for L<filter-spool|filter-spool> for sites that have
alternate methods for managing incoming mail.

=head1 OPTIONS

=over

=item C<-debug>

Like C<-verbose>, but prints much more.

=item C<-help>

Print out help message.

=item C<-man>

Print out the manpage.

=item C<-outdir> I<directory>

Directory to place mailbox files.  If not specified, the
current working directory is used.

=item C<-verbose>

Print status of what is going on.

=item C<-yearly>

Generate yearly-based mailbox files instead of monthly-based.

=back

=head1 DEPENDENCIES

This program uses MHonArc's date parsing functions.  Therefore,
MHonArc must be installed on your system and the MHonArc libraries
located within Perl's include path.

=head1 LIMITATIONS

=over

=item *

This program does not remember what messages it has processed.
For example, if you run the program twice in a row like the following:

  prompt> mbox-month-pack mail.mbx
  prompt> mbox-month-pack mail.mbx

The resulting monthly mailbox files will contain two of each message.

=item *

Appending to pre-existing gzipped monthly, and yearly, mailbox files
are not recognized when splitting input.  If you want output to be
appended to existing compressed mailboxes, you must uncompress them
first before invoking this program.

=back

=head1 VERSION

$Id: mbox-month-pack,v 1.4 2002/09/15 03:33:08 ehood Exp $

=head1 AUTHOR

Earl Hood, earl@earlhood.com

This program is part of the mharc archiving system and comes with
ABSOLUTELY NO WARRANTY and may be copied only under the terms of
the GNU General Public License, which may be found in the mharc
distribution.

=cut