#!/bin/sh
# -*- perl -*-
# This code allows us to start perl from our path or an environment variable
# rather than hardcoding a path into the #! line.  It works from sh or csh.
(exit $?0) && eval 'exec ${QPERLQ-perl} -x $0 ${1+"$@"}'
if (! $?QPERLQ) setenv QPERLQ perl
exec $QPERLQ -x $0 $argv:q

#!/usr/local/bin/perl -w
#
# $Id: mail_monthly,v 1.6 1997/11/12 14:10:14 ejb Exp $
# $Source: /home/ejb/scripts/RCS/mail_monthly,v $
# $Author: ejb $
#
# In a directory containing mail files generated from rmail files by 
# split_rmail, archive everything older than the current month.
#

require 5.002;
use strict;

my $whoami = ($0 =~ m,([^/\\]*)$,) ? $1 : $0;
#my $dirname = ($0 =~ m,(.*)[/\\][^/\\]+$,) ? $1 : ".";

my $force = 0;
if ((@ARGV == 1) && ($ARGV[0] eq "-force"))
{
    $force = 1;
}

my $rmail_header = "BABYL OPTIONS: -*- rmail -*-
Version: 5
Labels:
Note:   This is the header of an rmail file.
Note:   If you are seeing it in rmail,
Note:    it means the file has no messages in it.
";

my $after = "\037";
my $before = "\014\n";

my ($month, $year) = (localtime(time))[4,5];
my $this_ym = sprintf("%04d-%02d", $year + 1900, $month + 1);

my %files = ();
my $changes = 1;

if (-f "XMAIL")
{
    (system("split_rmail XMAIL") == 0) or
	die "$whoami: split_rmail XMAIL failed\n";
}

while ($changes)
{
    $changes = 0;
    %files = ();
    opendir(DIR, ".") or die "$whoami: opendir .: $!\n";
    my @entries = readdir(DIR) or die "$whoami: readdir .: $!\n";
    closedir(DIR);
    for (@entries)
    {
	if (m/^(\d{4}-\d{2})-(\d{2}-\d{2}:\d{2}:\d{2}-\d+)$/)
	{
	    my $ym = $1;
	    if ($force || ($ym ne $this_ym))
	    {
		my $rest = $2;
		if (! exists($files{$ym}))
		{
		    $files{$ym} = [];
		}
		push(@{$files{$ym}}, $rest);
	    }
	}
    }
    
    my $errors = 0;
    
    chop(my $pwd = `pwd`);
    # Take last two components of current directory
    $pwd =~ s,^(.*)/([^/]+/[^/]+)$,$2,;
    
    my $ym;
    foreach $ym (sort keys %files)
    {
	my $file = "$ym.rmail";
	if (-f "$file.gz")
	{
	    $changes = 1;
	    print "$whoami: $pwd: messages from $ym have been found but " .
		"$ym.rmail.gz already exists; splitting\n";
	    if (system("gunzip $file && split_rmail $file") != 0)
	    {
		warn "$whoami: failure uncompressing or splitting $file\n";
		$errors++;
	    }
	}
    }
    exit 2 if $errors;
}

undef $/;
my $ym;
foreach $ym (sort keys %files)
{
    my $outfile = "$ym.rmail";
    open(RMAIL, ">$outfile") or
	die "$whoami: can't create $outfile: $!\n";
    print RMAIL $rmail_header, $after;
    my @files = map { "$ym-$_" } (sort @{$files{$ym}});
    for (@files)
    {
	open(F, "<$_") or die "$whoami: failed to open $_: $!\n";
	print RMAIL $before, scalar(<F>), $after or
	    die "$whoami: append to $outfile failed: $!\n";
    }
    close(RMAIL) or die "$whoami: close of $outfile failed: $!\n";
    if (system("gzip $outfile") == 0)
    {
	for (@files)
	{
	    rename $_, ".#$_";
	}
	chmod 0444, "$outfile.gz";
    }
    else
    {
	die "$whoami: gzip $outfile failed\n";
    }
}