package GT::Maildir;

use vars qw/$error $ERRORS @EXPORT @EXPORT_OK %EXPORT_TAGS/;
use strict;
use warnings;
use base 'GT::Base';

sub ST_DEV() { 0 }
sub ST_INO() { 1 }
sub ST_MODE() { 2 }
sub ST_NLINK() { 3 }
sub ST_UID() { 4 }
sub ST_GID() { 5 }
sub ST_RDEV() { 6 }
sub ST_SIZE() { 7 }
sub ST_ATIME() { 8 }
sub ST_MTIME() { 9 }
sub ST_CTIME() { 10 }
sub ST_BLKSIZE() { 11 }
sub ST_BLOCKS() { 12 }

sub ST_NEW () { 1 }
sub ST_CUR () { 2 }

eval {
    require Time::HiRes;
    Time::HiRes->import;
};
use Cwd;
use Sys::Hostname;
use Carp qw/croak/;
use Exporter();

sub MAILDIR_DELIVERY_TIMEOUT() { 60 * 30 } # 30 minutes

$ERRORS = {
    CHDIR => 'Could not chdir to %s: %s',
    MKTMPFILE => 'Race condition creating tmp file for delivery to %s',
    FILE_MISSING => "Wrote maildir tmp file but now it's gone; Possible file system troubles",
    LINK => "Failed to link %s to %s: %s",
    OVERQUOTA => "User is over thier maildir quota",
    TIMEOUT => "Timed out on maildir delivery"
};

*import = \&Exporter::import;
$error = '';

@EXPORT = ();
@EXPORT_OK = qw(
    ST_NEW
    ST_CUR
    st_to_string

    ST_DEV
    ST_INO
    ST_MODE
    ST_NLINK
    ST_UID
    ST_GID
    ST_RDEV
    ST_SIZE
    ST_ATIME
    ST_MTIME
    ST_CTIME
    ST_BLKSIZE
    ST_BLOCKS
);
%EXPORT_TAGS = (
    all => [@EXPORT_OK, @EXPORT],
    stat => [qw/
        ST_DEV
        ST_INO
        ST_MODE
        ST_NLINK
        ST_UID
        ST_GID
        ST_RDEV
        ST_SIZE
        ST_ATIME
        ST_MTIME
        ST_CTIME
        ST_BLKSIZE
        ST_BLOCKS
    /],
    status => [qw(ST_NEW ST_CUR st_to_string)]
);

sub init {
    my $self = shift;
    my $class = ref $self;

    croak "Invalid arguments to $class->new. Arguments must be key/value pairs" if @_ & 1;
    my %opts = @_;
    $opts{ lc $_ } = delete $opts{$_} for keys %opts;

    croak "No Path specified to $class->new" unless exists $opts{path};
    my $path = delete $opts{path};
    croak "Invalid maildir path specified to $class->new" unless defined $path and length $path;
    my $locker = delete $opts{locker};
    unless ($locker) {
        require GT::Maildir::Lock::NFSLock;
        $locker = GT::Maildir::Lock::NFSLock->new;
    }
    my $subdir = delete $opts{subdir};
    my $maildir_subdir = delete $opts{maildirsubdir};

    $self->{_debug} = exists $opts{debug} ? delete $opts{debug} : $GT::Maildir::DEBUG;

    croak "Unknown arguments to $class->new: ", join(", ", keys %opts) if keys %opts;

    $self->{path} = $path;
    $self->{maildir_subdir} = $maildir_subdir || 'Maildir';
    $self->{subdir} = $subdir || 'gt';
    $self->{locker} = $locker;
}

sub st_to_string {
    my $st = shift;
    return $st == ST_NEW ? "new" : "cur";
}

sub make_maildir_root {
    my $self = shift;
    croak "Unknown arguments to $self->make_maildir: ", join(", ", @_) if @_;
    my $path = $self->get_maildir_path;
    my $config_path = $self->get_config_path;
    $self->get_locker->ex_lock($path, 60*5, 60*20);
    unless (-d $path) {
        unlink $path;
        mkdir $path, 0700 or return $self->error("MKDIR", "WARN", $path, "$!");
    }
    for (qw(cur new tmp)) {
        unless (-d "$path/$_") {
            unlink "$path/$_";
            mkdir "$path/$_", 0700 or return $self->error("MKDIR", "WARN", "$path/$_", "$!");
        }
    }
    unless (-d $config_path) {
        unlink $config_path;
        mkdir $config_path, 0700 or return $self->error("MKDIR", "WARN", $path, "$!");
    }
    $self->get_locker->unlock($path);
    return 1;
}

my $Maildir_Message_Number = 0;
sub deliver_message {
    my $self = shift;
    my $folder = shift;
    my $folder_name = UNIVERSAL::isa($folder, "GT::Maildir::Folder")
        ? $folder->get_name
        : $folder;
    croak "Invalid folder $folder_name"
        unless !ref($folder_name)
            and defined $folder_name
            and length $folder_name;
    my $mail_thingy = shift;
    my $mail_writer = UNIVERSAL::isa($mail_thingy, "GT::Mail")
        ? sub { $mail_thingy->write(shift) or die "$GT::Mail::error" }
        : (!ref($mail_thingy) and -e $mail_thingy)
            ? sub { require GT::File::Tools; GT::File::Tools::copy($mail_thingy, shift) or die "$GT::File::Tools::error" }
            : undef;
    croak "Unknown email input $mail_thingy" unless defined $mail_writer;
    my $quotastr = shift;

    my $flags = join '', map { uc substr($_, 0, 1) } grep { defined and /^[DFRST]/i } @_;

    my $path = $self->get_maildir_path;
    my $folder_path = "$path/$folder_name";
    my $cwd = getcwd || cwd || die "Could not get cwd";
    unless (ref $mail_thingy) {
        if ($mail_thingy !~ m{^/}) {
            $mail_thingy = "$cwd/$mail_thingy";
        }
    }
    chdir $folder_path or return $self->error("CHDIR", "WARN", $folder_path, "$!");
    local $@;
    eval {
        local $SIG{__DIE__};
        alarm 0;
    };
    my $can_alarm = $@ ? 0 : 1;
    local $SIG{ALRM} = sub { die "TIMEOUT\n" };
    my $pid = $$;
    my $host = hostname;
    $Maildir_Message_Number++;

    my $tmpfile;
    for (my $i = 0; ; $i++) {
        my $t = time;
        $tmpfile = "tmp/$t.$pid.$Maildir_Message_Number.$host";
        if (!stat($tmpfile) and $! == 2) { # ENOENT
            last;
        }
        if ($i == 2) {
            return $self->error("MKTMPFILE", "WARN", "$folder_path/$tmpfile");
        }
        sleep 2;
    }
    if ($can_alarm) {
        alarm(MAILDIR_DELIVERY_TIMEOUT);
    }
    my $newfile;
    eval {
        $mail_writer->($tmpfile);
        undef $mail_thingy;
        undef $mail_writer;
        my @st = stat $tmpfile;
        die "FILE_MISSING\n" unless @st;
        if ($st[ST_SIZE] != 0 and $quotastr and $quotastr ne "NOQUOTA") {
            require GT::Maildir::Quota;
            my $q = GT::Maildir::Quota->open(".", $quotastr) or die "$GT::Maildir::Quota::error\n";
            if (!$q->test($st[ST_SIZE], 1)) {
                die "$GT::Maildir::Quota::error\n" if $GT::Maildir::Quota::error;
                die "OVERQUOTA\n";
            }
            $q->add($st[ST_SIZE], 1);
            $q->close();
        }
        my $new_tmp = "$tmpfile,S=$st[ST_SIZE]:2,$flags";
        if (!rename($tmpfile, $new_tmp)) {
            $self->error("RENAME", "FATAL", $tmpfile, $new_tmp, "$!");
        }
        $newfile = $new_tmp;
        $newfile =~ s/tmp/new/;

        if (!link($new_tmp, $newfile)) {
            $self->error("LINK", "FATAL", $new_tmp, $newfile, "$!");
        }
        unlink $new_tmp;
    };
    if ($can_alarm) {
        alarm 0;
    }
    if ($@) {
        my $err = $@;
        $err =~ s/\n//g;
        chdir $cwd;
        return $self->error($err, "WARN");
    }
    chdir $cwd;
    return $newfile;
}

sub get_locker {
    my $self = shift;
    croak "Unknown arguments to $self->get_locker: ", join(", ", @_) if @_;
    return $self->{locker};
}

sub get_path {
    my $self = shift;
    croak "Unknown arguments to $self->get_path: ", join(", ", @_) if @_;
    return $self->{path};
}

sub get_subdir {
    my $self = shift;
    croak "Unknown arguments to $self->get_subdir: ", join(", ", @_) if @_;
    return $self->{subdir};
}

sub get_maildir_subdir {
    my $self = shift;
    croak "Unknown arguments to $self->get_maildir_subdir: ", join(", ", @_) if @_;
    return $self->{maildir_subdir};
}

sub get_maildir_path {
    my $self = shift;
    croak "Unknown arguments to $self->get_subdir: ", join(", ", @_) if @_;
    return $self->{path} . "/" . $self->{maildir_subdir};
}

sub get_config_path {
    my $self = shift;
    croak "Unknown arguments to $self->get_subdir: ", join(", ", @_) if @_;
    return $self->{path} . "/" . $self->{subdir};
}

1;