#!/usr/bin/perl
###########################################################
#
# Copyright 2005 by Sean Conner.  All Rights Reserved.
#
# 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.
#
# Comments, questions and criticisms can be sent to: sean@conman.org
#
# ------------------------------------------------------------
#
# Move emails out of a sendmail queue
#
# usage:
#	movequeue.pl [-d directory] [-t directory] 
#		[-h pattern] 
#		[-b pattern]
#		[-D]
#
#	where
#		-d = src directory of queue
#		-t = dest directory to move email
#		-h = search for pattern in headers
#		-b = search for pattern in body
#		-D = enable debug output
#
##########################################################

use Getopt::Std;
use File::Copy;
use strict;

use vars qw(@queue %have $opt_h $opt_b $opt_d $opt_t $opt_D);
my $entry;
my $thing;
my $target = "/tmp/deferred";

getopts('h:b:d:t:D');

if ($opt_d)
{
  chdir($opt_d);
}

if ($opt_t)
{
  $target = $opt_t;
}

if (!-d $target)
{
  mkdir($target) or die "Can't create target directory $target\n";
}

opendir(DIR,".") or die "Can't open queue directory\n";
while($entry = readdir(DIR))
{
  #print ("adding $entry\n") if ($opt_D);
  if ($entry =~ /[dqx](.*)/)
  {
    $thing = $1;
    #print ("adding $thing\n") if ($opt_D);
    if (!$have{$thing})
    {
      push @queue,$thing;
      $have{$thing} = 1;
    }
  }
}
closedir(DIR);

if ($opt_h)
{
  print ("h = $opt_h\n");
  &process_headers($opt_h);
}

if ($opt_b)
{
  &process_bodies($opt_b);
}

#########################################################################

sub process_headers
{
  my $criteria = shift;
  my $reg = qr/$criteria/o;
  my $line;
  my $file;
  my $entry;
  
  print ("Parsing headers\n") if ($opt_D);
  foreach $entry (@queue)
  {
    $file = 'q' . $entry;
    #print ("file: $file\n") if ($opt_D);
    open(FILE,$file) or next;
    while($line = <FILE>)
    {
      if ($line =~ /$reg/)
      {
        close(FILE);
        print "Moving q$entry - d$entry - x$entry\n" if ($opt_D);
	copy('q' . $entry , $target . '/' . 'q' . $entry);
	copy('d' . $entry , $target . '/' . 'd' . $entry);
	copy('x' . $entry , $target . '/' . 'x' . $entry);
        unlink('q' . $entry);
        unlink('d' . $entry);
        unlink('x' . $entry);
        next;
      }
    }
    close(FILE);
  }
}

########################################################################

sub process_bodies
{
  my $criteria = shift;
  my $file;
  my $entry;
  my $line;
  
  foreach $entry (@queue)
  {
    $file = 'd' . $entry;
    open(FILE,$file) or next;
    while($line = <FILE>)
    {
      if ($line =~ /$criteria/)
      {
        close(FILE);
        print "Moving q$entry - d$entry - x$entry\n" if ($opt_D);
	copy('q' . $entry , $target . '/' . 'q' . $entry);
	copy('d' . $entry , $target . '/' . 'd' . $entry);
	copy('x' . $entry , $target . '/' . 'x' . $entry);
        unlink('q' . $entry);
        unlink('d' . $entry);
        unlink('x' . $entry);
        next;
      }
    }
    close(FILE);
  }
}

########################################################################