Email::LocalDelivery::Ezmlm - deliver mail into ezmlm archives

Email-LocalDelivery-Ezmlm documentation Contained in the Email-LocalDelivery-Ezmlm distribution.

Index

Code Index:

NAME

Top

Email::LocalDelivery::Ezmlm - deliver mail into ezmlm archives

SYNOPSIS

Top

 use Email::LocalDelivery;
 Email::LocalDelivery->deliver($mail, "/some/box//") or die "couldn't deliver";

DESCRIPTION

Top

This module delivers RFC822 messages into ezmlm-style archive folders.

This module was created to allow easy interoperability between Siesta and colobus. Colobus is an nntp server which uses ezmlm archives as its message store.

METHODS

Top

->deliver( $message, @folders )

used as a class method. returns the names of the files ultimately delivered to

AUTHOR

Top

Richard Clamp <richardc@unixbeard.net> based on the source of colobus by Jim Winstead Jr.

COPYRIGHT

Top

Copyright (C) 2003 Richard Clamp. All Rights Reserved.

This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

SEE ALSO

Top

colobus, Email::LocalDelivery, Email::FolderType

Email-LocalDelivery-Ezmlm documentation Contained in the Email-LocalDelivery-Ezmlm distribution. 
use strict;
package Email::LocalDelivery::Ezmlm;
our $VERSION = '0.10';
use File::Path qw(mkpath);
use File::Basename qw( dirname );


sub deliver {
    my ($class, $mail, @folders) = @_;

    my @delivered;
    for my $folder (@folders) {
        # trim the identifier off, as mkpath doesn't get on with it
        $folder =~ s{//?$}{};
        # XXX should lock the folder - figure out how ezmlm does that

        my $num;
        if (open my $fh, "$folder/num") {
            ($num) = (<$fh> =~ m/^(\d+)/);
        }
        ++$num;

        my $filename = sprintf('%s/archive/%d/%02d',
                               $folder, int $num / 100, $num % 100);
        eval { mkpath( dirname $filename ) };
        open my $fh, ">$filename" or next;
        print $fh $mail;
        close $fh or next;

        open $fh, ">$folder/num" or do { unlink $filename; next };
        print $fh "$num\n";
        close $fh or die "couldn't rewrite '$folder/num' $!";
        push @delivered, $filename;
    }
    return @delivered;
}

1;
__END__