#!/usr/bin/perl 
#
# Sorts a maildir for access through IMAP.
#
# The maildir is expected in the following format:
#
# ~/Maildir
#          /{new,cur,tmp}
#          /.folder1
#                   /{new,cur,tmp}
#          /.folder2
#                   /{new,cur,tmp}
#
# This program goes through ~/Maildir/new and moves messages to
# ~/Maildir/.folder/new according to the rules defined below.
#
# The rules applies as such: every message is searched for a
# "Delivered-To: user+ext@domain" header. The CONFIG_FILE below is
# looked up to match "ext" to "folder".
# 
# Renaud Waldura <renaud@waldura.com> September 2000
#

use strict;
use vars qw( $ENV );

use constant DEBUG => 0;

use constant MAILDIR => 'Maildir';
use constant NEWMAILDIR => 'new';

use constant CONFIG_FILE => '.sort-maildir';


my $debug = DEBUG + $ENV{DEBUG};
my $home = $ENV{HOME};

my $maildir = $home . '/' . MAILDIR;
my $newmaildir = $maildir. '/' . NEWMAILDIR;

my $config_file = $home . '/' . CONFIG_FILE;
my $config = read_config($config_file);


foreach my $mesg (<$newmaildir/*>)		# look at all new messages
{
   # get "Delivered-To:" header
   my $delivered_to = get_deliveredto_header($mesg);
   next unless ($delivered_to);
   
   warn "$mesg was delivered to: $delivered_to" if ($debug);
   
   # get extension from header
   my $extension = get_extension($delivered_to);
   next unless ($extension);
   
   warn "extension = $extension" if ($debug);
   
   # get folder from extension
   my $folder = get_folder($extension, $config);
   next unless ($folder);
   
   warn "folder = $folder" if ($debug);
   
   # get directory from folder
   my $dir = get_directory($folder, $maildir);
   next unless ($dir);
   
   warn "directory = $dir" if ($debug);
   
   # process message
   move_mesg($mesg, $dir);
   
   warn "moved $mesg to $dir" if ($debug);
}


#####################################################################
sub read_config
{
   my($path) = @_;
   my %config;
   
   open(CONFIG, $path) or die;
   
   while (<CONFIG>)
   {
      next if (/^\s*#/);	# skip comments
      next if (/^\s*$/);	# skip blank lines
	       
      my($ext, $folder) = split;
      $config{$ext} = $folder;

      warn "config: $ext => $folder" if ($debug);
   }
   
   close CONFIG;

   return \%config;
}

#####################################################################
sub get_deliveredto_header
{
   my($path) = @_;
   my $return;
   
   open(MESG, $path) or die;
   
   while (<MESG>)
   {
      chomp;
      
      if (s/^delivered-to: //i)
      {
	 $return = $_;
	 last;
      }
   }
   
   close MESG;
   
   return $return;
}

#####################################################################
sub get_extension
{
   my($delivered_to) = @_;
   
   my($username, $extension, $domain) =
   $delivered_to =~ /^(.+?)\+(.+?)@(.+?)$/;
   
   return lc $extension;
}

#####################################################################
sub get_folder
{
   my($extension, $config) = @_;
   
   my $folder = $config->{$extension};
   
   return $folder;
}

#####################################################################
sub get_directory
{
   my($folder, $maildir) = @_;
   
   my $d = "$maildir/.$folder/" . NEWMAILDIR;
   
   return (-d $d) ? $d : undef;
}

#####################################################################
sub move_mesg
{
   my($file, $dir) = @_;
   system "mv -i $file $dir";
}